Scanning 
Objects in the 
FUSER

Introduction	3
Scope	3
Basic View Structure	3
SRCTX structure	4
SRCTX Header Records	4
SRCTX (1)	4
SRCTX (2)	5
SRCTX Detail Records	5
All Object Types	5
Data-Areas	5
Example 1 – Simple Data-Area	6
Example 2 – Views	7
Example 3 – Edited Fields	8
Example Program	9

Introduction

On MVS platforms, all the natural objects are held in an ADABAS file. This is usually called SYSTEM-FUSER (depending on your DDM set up) and is commonly referred to as the FUSER file. Note this isn’t true for all platforms. For example in Natural Lightstorm (a PC platform) the objects are held in text files.   

This document explains the basic structure of the FUSER file (for scanning source code) and gives an example of a program that can be used to scan LDAs for initialised text.

Scope

The FUSER file holds both source and object code. This document is only interested in the source code side of things.

It assumed that the reader is familiar with both Natural and Adabas.

Basic View Structure

The basic view structure is: -

 1 SYSTEM-FUSER VIEW OF SYSTEM-FUSER                                     
   2 SRCID                                                               
   2 REDEFINE SRCID                                                      
     3 SRCID-LIBRARY (A8)                                                
     3 SRCID-OBJECT  (A8)                                                
     3 SRCID-SEQ     (B2)     /* hex value – unique within object 
   2 REDEFINE SRCID                                                      
     3 SRCID-LIB-OBJ (A16)                                               
   2 C*SRCTX                                                             
   2 SRCTX(1:191)     

Typically the FUSER file hold all objects for all libraries, for a specific environment. ie all development code will be in one file, while production code will be in a different file. 

An individual Natural object can span a number of records.

The SRCID descriptor uniquely identifies each record.

The first block of code for an object will have a SRCID-SEQ of 0001 (in hex) followed by 0002 and so on.  

SRCTX holds the actual object information.

SRCTX structure

The SRCTX field has a structure in itself.

If you move SRCTX (index) to #SRCTX it would have the following structure.

 1 #SRCTX              (A90)                                             
 1 REDEFINE #SRCTX                                                       
   2 #LINE-NUM         (B2)                                              
   2 #LINE-TEXT        (A88)

SRCTX records can be split into two groups 

•	Header records
•	Details records 
SRCTX Header Records

The first 3 occurrences of SRCTX (of the first block ie SRCID-SEQ = 0001) holds information specific to that object. The kind of information you see when you list the directory of an object (L DIR).

Note that #LINE-NUM is 0000 for these 3 occurrences.
SRCTX (1)

 MOVE SRCTX(1) TO #SRCTX-1 

 1 #SRCTX-1            (A90)                                             
 1 REDEFINE #SRCTX-1                                                     
   2 FILLER            2X                                                
   2 #VERSION          (A4)       /* eg NAT2                             
   2 FILLER            2X                                                
   2 #OBJ-TYPE         (A1)       /* 'F' = Program                       
                                  /* 'N' = Subprogram                                                 
                                  /* 'S' = Subroutine                                                 
                                  /* 'M' = Map                                                        
                                  /* 'G' = Copycode                                                   
                                  /* 'A' = PDA                                                        
                                  /* 'C' = GDA                                                        
                                  /* 'L' = LDA                                                        
                                  /* 'T' = Text                                                       
   2 FILLER            1X                                                
   2 #VERSION-NUM      (A4)       /* eg 2.1                              
   2 #SM-LEVEL         (A4)                                              
   2 FILLER            4X                                                
   2 #LIBRARY          (A8)                                              
   2 #OBJECT           (A8)
   2 #USER-ID          (A8)                                              
   2 #TERMINAL-ID      (A8)                                              
   2 #TERMINAL-USER    (A8)                                              
   2 FILLER            6X                                                
   2 #MODE             (A1)       /* 'S' structured mode  

Note that the object types aren’t necessarily what you would expect. For example

 'F' 	= Program
 'G' 	= Copycode                                                   
 'C' 	= GDA                                                        

SRCTX (2)

 MOVE SRXTX(2) TO #SRCTX-2

 1 #SRCTX-2            (A90)                                             
 1 REDEFINE #SRCTX-2                                                     
   2 FILLER            6X                                                
   2 #SAVED-TIME-STAMP (T)                                               
   2 FILLER            9X                                                
   2 #OP-SYS           (A8)      /* eg MVS/XA                            
   2 #TP-SYS           (A8)      /* eg CICS                              
   2 FILLER           12X                                                
   2 #TIME-SAVED       (A7)      /* HHMMSST                              
   2 FILLER            1X                                                
   2 #DATE-SAVED       (A8)      /* YYYYMMDD                             
   2 #TRANSACTION      (A4)      /* eg RPMT

 
SRCTX Detail Records
All Object Types

For all objects, the basic format is very simple. 

#LINE-NUM 	is the line number of the code (in hex)
#LINE-TEXT 	is the code itself. 

For maps the code appears the same as if you did a 

L map-name 

Data-areas are more complicated. 

Data-Areas
The format of SRCTX for data-area is best explained with a few examples 

Example 1 – Simple Data-Area
 
The following data-area is a straightforward LDA. 

•	No fields are edited for further details
•	Contains no views 
 
 I T L Name                             F Leng Index/Init/EM/Name/Comment
 All - -------------------------------- - ---- --------------------------
     1 #GROUP                                                            
     2 #ITEM                            A   10                           
     2 #AMOUNT                          P  7.2                           
     2 #ARRAY                           A    2 (1:10)                    
     2 #DATE                            D      (EM=YYYY-MM-DD)           
   *                                                                     
   *   example of some comments                                          
   *                                                                     
     1 #MAX                             N    2 CONST<10>                 
   *                                                                     
     1 #NUM                             N    9                           
   R 1 #NUM                                                              
     2 #ALPHA                           A    9       

It appears as the following, in the #LINE-TEXT part of the SRCTX field.   

         1         2         3         4         5         6         7
1234567890123456789012345678901234567890123456789012345678901234567890
**DS         ?        1#GROUP                                             
**DK         ?  A  10 2#ITEM                                              
**DK         ?  P 7.2 2#AMOUNT                                            
**DK I1      ?  A   2 2#ARRAY                          (1:10)             
**DK     E   ?  D     2#DATE                           (EM=YYYY-MM-DD)    
**C                  *                                                    
**C                  * example of some comments                           
**C                  *                                                    
**DF   I     ?  N   2 1#MAX                            CONST<10>          
**C                  *                                                    
**DF         ?  N   9 1#NUM                                               
**DRR        ?       R1#NUM                                               
**DFR        ?  A   9 2#ALPHA                                             
1234567890123456789012345678901234567890123456789012345678901234567890
         1         2         3         4         5         6         7

From	To	Size	Value	Meaning	
1	2	2	**	Not sure why, but its on every line of a data-area 	
3	3	1	D	Field name and format on this line	
 	 		C	A comment line	
4	4	1	S	A group structure	
			K	Part of a group structure	
			F	Normal field	
			R	Redefinition of the field	
5	5	1	R	Part of a redefinition	
6	6	1	I	Is an array	
7	7	1	1,2,3	Number of dimensions for the array	
8	8	1	I	An INIT or CONST exists	
10	10	1	E	An EM or HD exists	
14	14	1	?	Unknown hex value 	
17	17	1	A,N ..	Data Format	
18	21	4		Length – right justified eg 10.2	
22	22	1	*	Comment	
			R	Redefinition	
23	23	1	1,2 .. 	Level number	
24	55	32		Field Name	
56	77	22		Index/Init/EM/Name/Comment	
Example 2 – Views

The following data-area is a view of a DDM 

 
 I T L Name                             F Leng Index/Init/EM/Name/Comment   
 All - -------------------------------- - ---- -----------------------------
   V 1 EMPLOYEES-VIEW                          EMPLOYEES                    
     2 PERSONNEL-ID                     A    8 /* CNNNNNNN                  
   G 2 FULL-NAME                                                            
     3 FIRST-NAME                       A   20                              
     3 MIDDLE-I                         A    1                              
     2 BIRTH                            N  6.0                              
   C 2 ADDRESS-LINE                                                         
   G 2 FULL-ADDRESS                                                         
   M 3 ADDRESS-LINE                     A   20 (1:8)                        
   P 2 INCOME                                                               
     3 SALARY                           P  9.0 (1:191) /* FIELD IN PE       

It appears as the following, in the #LINE-TEXT part of the SRCTX field.   

         1         2         3         4         5         6         7
1234567890123456789012345678901234567890123456789012345678901234567890
**DV         ?       V1EMPLOYEES-VIEW                  EMPLOYEES          
**DD         ?  A   8 2PERSONNEL-ID                    /* CNNNNNNN
**DD    C    ?       G2FULL-NAME                                          
**DD         ?  A  20 3FIRST-NAME                                         
**DD         ?  A   1 3MIDDLE-I                                           
**DD         ?  N 6.0 2BIRTH                     
**DD    *    ?       C2ADDRESS-LINE                                                                
**DD    C    ?       G2FULL-ADDRESS                                       
**DD I1 C    ?  A  20M3ADDRESS-LINE                    (1:8)              
**DD    C    ?       P2INCOME                                             
**DD I1      ?  P 9.0 3SALARY                          (1:191) /* FIEL 
1234567890123456789012345678901234567890123456789012345678901234567890
         1         2         3         4         5         6         7

From	To	Size	Value	Meaning	
4	4	1	V	View of DDM line	
			D	Field of a View	
9	9	1	C	A Group within a View 	
		1	*	Counter for a Multiple field	

Example 3 – Edited Fields
Now things get more complicated. In this example we have fields that have been edited for :-

•	Single value initialisation
•	Free mode initialisation
•	Edit Masks
•	Combination of the above

 
 I T L Name                             F Leng Index/Init/EM/Name/Comment  
 All - -------------------------------- - ---- ----------------------------
 I   1 #SINGLE-FIELD-1                  A    4                             
 I   1 #SINGLE-FIELD-ARRAY              A    4 (1:5)                       
 I   1 #FREE-FIELD                      A    4                             
 M   1 #EM-FIELD                        A    4                             
 S   1 #COMBO                           A    4               

                                                                      
It appears as the following, in the #LINE-TEXT part of the SRCTX field.   

         1         2         3         4         5         6         7
1234567890123456789012345678901234567890123456789012345678901234567890
**DF   S     ? ?A   4 1#SINGLE-FIELD-1                                    
**DF I1S     ? ?A   4 1#SINGLE-FIELD-ARRAY             (1:5)              
**DF   F     ? ?A   4 1#FREE-FIELD                                        
**DF     X   ? ?A   4 1#EM-FIELD                                          
**DF   S X   ? ?A   4 1#COMBO                                             
**HS ?                                                                    
**I                      aaaa                                             
**HS ?                                                                    
**I(1)                   1111                                             
**I(2)                   2222
**I(3)                   3333                                             
**I(4)                   4444                                             
**I(5)                   5555                                             
**HF ?                                                                    
**I                      CONST<'ABCD'>                                    
**HX ?                                                                    
**IXUU9 HD='Header for EM example'                                        
**HS ?                                                                    
**I                      zzzz                                             
**HX ?                                                                    
**IXXXX HD='HEADER for Combo Example'
1234567890123456789012345678901234567890123456789012345678901234567890
         1         2         3         4         5         6         7

From	To	Size	Value	Meaning	
3	3	1	H	Header record. Links to the variable name by sequence number	
			I	Detail records 	
4	4	1	S	Single value Initialisation	
		 	F	Free mode Initialisation	
		 	X	Edit Mask and HD definition	
5	6	 2	 ?	Sequence number (in hex) that links to the sequence number (col 15-16) on the variable name record.  	
15	16	2	 ?	Sequence number on the variable name record (in hex) that links to the sequence number (col 5-6) on the header record.	
4	25	22		For detail records (‘I’ in column 3) of single value / free mode initialisation, this contain the array occurrence (if any)  	
26	70	45		The value for the single value / free mode initialisation	
4	70	67		The value for the Edit Mask and HD definition	

Example Program

The following program is an example of how you can scan LDAs for any initialised text.
It highlights the basic structure of the FUSER file, and specifically shows the structure of data-area objects.
Note the code can be made more efficient, by using some skip logic. Basically this mean putting the READ loop inside a REPEAT loop and advancing the starting key. This wasn’t done here as it is complicated enough already.       

 0010 ************************************************************************
 0020 *                                                                       
 0030 *  Program : XCDDEMO                                                    
 0040 *  Author  : Chris Duncan                                               
 0050 *  Date    : 4 Feb 2000                                                 
 0060 *  Desc    : This code is an example of how you can scan the FUSER file 
 0070 *            for an initialised piece of text                           
 0080 *                                                                       
 0090 *            - it shows the basic FUSER structure                       
 0100 *            - structure of data-areas in the FUSER file                
 0110 *                                                                       
 0120 ************************************************************************
 0130 DEFINE DATA                                                             
 0140 LOCAL                                                                   
 0150 *                                                                       
 0160 * ------------------                                                    
 0170 * views                                                                 
 0180 * ------------------                                                    
 0190 *                                                                       
 0200 1 SYSTEM-FUSER VIEW OF SYSTEM-FUSER                                     
 0210   2 SRCID                                                               
 0220   2 REDEFINE SRCID                                                      
 0230     3 SRCID-LIBRARY (A8)                                                
 0240     3 SRCID-OBJECT  (A8)                                                
 0250     3 SRCID-SEQ     (B2)                                                
 0260   2 REDEFINE SRCID                                                      
 0270     3 SRCID-LIB-OBJ (A16)                                               
 0280   2 C*SRCTX                                                             
 0290   2 SRCTX(1:191)                                                        
 0300 *                                                                       
 0310 *                                                                       
 0320 * ------------------                                                    
 0330 * key                                                                   
 0340 * ------------------                                                    
 0350 *                                                                       
 0360 1 #SRCID-KEY               (A18)                                        
 0370 1 REDEFINE #SRCID-KEY                                                   
 0380   2 #SRCID-LIBRARY         (A8)                                         
 0390   2 #SRCID-OBJECT          (A8)                                         
 0400   2 #SRCID-SEQ             (A2)                                          
 0410 *                                                                       
 0420 *                                                                       
 0430 *                                                                       
 0440 * ------------------                                                    
 0450 * record layouts                                                        
 0460 * ------------------                                                    
 0470 *                                                                       
 0480 1 #SRCTX              (A90)                                             
 0490 1 REDEFINE #SRCTX                                                       
 0500   2 #LINE-NUM         (B2)                                              
 0510   2 #LINE-TEXT        (A88)                                             
 0520   2 REDEFINE #LINE-TEXT                                                 
 0530     3 #DOUBLE-ASTERIX (A2)                                              
 0540     3 #REC-TYPE-1     (A1)   /* C   comment                             
 0550 *                            /* D   definition                          
 0560 *                            /* H   header                              
 0570 *                            /* I   initialised value                   
 0580     3 #REC-TYPE-2     (A1)   /* V   view                                
 0590 *                            /* D   field of a view                     
 0600 *                            /* R   redefined field
 0610 *                            /* X   has an edit mask                    
 0620 *                            /* F   field                               
 0630 *                            /* S   seq num to follow                   
 0640     3 #REC-TYPE-3     (A1)   /* C   line uses a CONST field             
 0650 *                            /* R   part of a redefinition              
 0660 *                            /* 0-9 initialised occurrence               
 0670     3 #REC-TYPE-4     (A1)   /* I   array                               
 0680     3 #REC-TYPE-5     (A1)   /* 1,2,3   number of dimensions            
 0690     3 #REC-TYPE-6     (A1)   /* I   CONST or INIT field on comment part 
 0700 *                            /* S   Single mode initialisation          
 0710 *                            /* F   Free   mode initialisation          
 0720     3 #REC-TYPE-7     (A1)   /* *   C* field                            
 0730 *                            /* C   Multi / Period Grp / Grp            
 0740     3 FILLER           7X                                               
 0750     3 #FORMAT         (A1)   /*     Format                              
 0760     3 #LENGTH         (A4)   /*     Length                              
 0770     3 #REC-TYPE-20    (A1)   /* M   Multiple Field                      
 0780 *                            /* C   C* fields                           
 0790 *                            /* P   Periodic Group                      
 0800 *                            /* G   Group                               
 0810     3 #LEVEL          (A1)   /*     Level                               
 0820     3 REDEFINE #LEVEL                                                   
 0830       4 #LEVEL-NUM    (N1)                                              
 0840     3 #VARIABLE       (A32)  /*     Variable Name                       
 0850     3 #REST           (A33)  /*     comments / array / INITs / EM       
 0860     3 REDEFINE #REST                                                    
 0870       4 #REST-CHAR    (A1/33)                                           
 0880 *                                                                       
 0890   2 REDEFINE #LINE-TEXT                                                 
 0900     3 FILLER             3X                                             
 0910     3 #INITIAL-ARRAY  (A22)                                             
 0920     3 #INITIAL-VALUE  (A63)                                             
 0930 *                                                                       
 0940   2 REDEFINE #LINE-TEXT                                                 
 0950     3 FILLER              4X                                            
 0960     3 #SEQ-FIELD         (A2)                                           
 0970     3 #UNKNOWN           (A8)                                           
 0980     3 #SEQ-INIT-OR-MASK  (A2)                                           
 0990 * 
 1000 * 
 1010 *                                                                       
 1020 *                                                                       
 1030 *                                                                       
 1040 1 #SRCTX-1            (A90)                                             
 1050 1 REDEFINE #SRCTX-1                                                     
 1060   2 FILLER            2X                                                
 1070   2 #VERSION          (A4)       /* eg NAT2                             
 1080   2 FILLER            2X                                                
 1090   2 #OBJ-TYPE         (A1)       /* 'F' = Program                       
 1100 *                                /* 'N' = Subprogram                    
 1110 *                                /* 'S' = Subroutine                    
 1120 *                                /* 'M' = Map                           
 1130 *                                /* 'G' = Copycode                      
 1140 *                                /* 'A' = PDA                           
 1150 *                                /* 'C' = GDA                           
 1160 *                                /* 'L' = LDA                           
 1170 *                                /* 'T' = Text                          
 1180   2 FILLER            1X                                                
 1190   2 #VERSION-NUM      (A4)       /* eg 2.1                              
 1200   2 #SM-LEVEL         (A4)
 1210   2 FILLER            4X                                                
 1220   2 #LIBRARY          (A8)                                              
 1230   2 #OBJECT           (A8)                                              
 1240   2 #USER-ID          (A8)                                              
 1250   2 #TERMINAL-ID      (A8)                                              
 1260   2 #TERMINAL-USER    (A8)                                              
 1270   2 FILLER            6X                                                
 1280   2 #MODE             (A1)       /* 'S' structured mode                 
 1290 *                                                                       
 1300 *                                                                       
 1310 *                                                                       
 1320 1 #SRCTX-2            (A90)                                             
 1330 1 REDEFINE #SRCTX-2                                                     
 1340   2 FILLER            6X                                                
 1350   2 #SAVED-TIME-STAMP (T)                                               
 1360   2 FILLER            9X                                                
 1370   2 #OP-SYS           (A8)      /* eg MVS/XA                            
 1380   2 #TP-SYS           (A8)      /* eg CICS                              
 1390   2 FILLER           12X                                                
 1400   2 #TIME-SAVED       (A7)      /* HHMMSST
 1410   2 FILLER            1X                                                
 1420   2 #DATE-SAVED       (A8)      /* YYYYMMDD                             
 1430   2 #TRANSACTION      (A4)      /* eg RPMT                              
 1440 *                                                                       
 1450 *                                                                       
 1460 *                                                                       
 1470 * ------------------                                                    
 1480 * flags                                                                 
 1490 * ------------------                                                    
 1500 *                                                                       
 1510 1 #L-REJECT                (L)                                          
 1520 1 #L-SCAN-INIT-PORTION     (L)                                          
 1530 *                                                                       
 1540 *                                                                       
 1550 * ------------------                                                    
 1560 * misc                                                                  
 1570 * ------------------                                                    
 1580 *                                                                       
 1590 1 #INDEX            (N5)                                                
 1600 1 #I                (N5)
 1610 1 #SRCID-LIB-OBJ    (A16)                                               
 1620 1 #FILLER-22        (A22)                                               
 1630 1 #HOLD-VARIABLE    (A32)                                               
 1640 1 #HOLD-SEQ-FIELD   (A2)                                                
 1650 *                                                                       
 1660 1 #SEARCH-TEXT      (A20)                                               
 1670 *                                                                       
 1680 1 #INIT-IDX         (P3)                                                
 1690 1 #INIT-VAR         (A32/100)                                           
 1700 1 #INIT-SEQ         (A2/100)                                            
 1710 *                                                                       
 1720 *                                                                       
 1730 END-DEFINE                                                              
 1740 *                                                                       
 1750 *                                                                       
 1760 *                                                                       
 1770 ************************************************************************
 1780 *                                                                       
 1790 *  I n i t i a l i s e   S e c t i o n                                  
 1800 *
 1810 ************************************************************************
 1820 *                                                                       
 1830 INPUT 'Scan LDAs for CONST or INIT text:' #SEARCH-TEXT                  
 1840 *                                                                       
 1850 FORMAT LS=249                                                           
 1860 *                                                                       
 1870 MOVE ALL H'00'    TO #SRCID-KEY                                         
 1880 MOVE 'LIBRARY'    TO #SRCID-LIBRARY  /* starting library name here      
 1890 MOVE 'OBJECT'     TO #SRCID-OBJECT   /* starting object  name here      
 1900 *                                                                       
 1910 *                                                                       
 1920 *                                                                       
 1930 ************************************************************************
 1940 *                                                                       
 1950 *  M a i n   P r o g r a m                                              
 1960 *                                                                       
 1970 ************************************************************************
 1980 *                                                                       
 1990 *                                                                       
 2000 READ SYSTEM-FUSER BY SRCID STARTING FROM #SRCID-KEY                     
 2010 *                                                                       
 2020 * add code to decide when to end                                        
 2030 *                                                                       
 2040   PERFORM CHECK-IF-LDA                                                  
 2050   REJECT IF #L-REJECT                                                   
 2060   PERFORM READ-LDA-CONTENTS                                             
 2070 END-READ                                                                
 2080 *                                                                       
 2090 *                                                                       
 2100 *                                                                       
 2110 ************************************************************************
 2120 *                                                                       
 2130 *  S u b r o u t i n e s                                                
 2140 *                                                                       
 2150 ************************************************************************
 2160 *                                                                       
 2170 *                                                                       
 2180 * ----------------============                                          
 2190 DEFINE SUBROUTINE CHECK-IF-LDA                                          
 2200 * ----------------============
 2210 *                                                                       
 2220 IF     SRCID-LIB-OBJ NE #SRCID-LIB-OBJ           /* break of object     
 2230 *                                                                       
 2240   MOVE SRCID-LIB-OBJ TO #SRCID-LIB-OBJ                                  
 2250 *                                                                       
 2260   MOVE SRCTX(1) TO #SRCTX-1                      /* object header info  
 2270   MOVE SRCTX(2) TO #SRCTX-2                                             
 2280 *                                                                       
 2290   IF #OBJ-TYPE = 'L'                             /* LDA                 
 2300     MOVE FALSE TO #L-REJECT                                             
 2310     MOVE FALSE TO #L-SCAN-INIT-PORTION                                  
 2320     RESET                                                               
 2330       #INIT-IDX                                                         
 2340       #INIT-VAR   (*)                                                   
 2350       #INIT-SEQ   (*)                                                   
 2360 *                                                                       
 2370   ELSE                                                                  
 2380 *                                                                       
 2390     MOVE TRUE  TO #L-REJECT                                             
 2400 *
 2410   END-IF                                                                
 2420 *                                                                       
 2430 END-IF                                                                  
 2440 *                                                                       
 2450 END-SUBROUTINE                                                          
 2460 *                                                                       
 2470 *                                                                       
 2480 *                                                                       
 2490 *                                                                       
 2500 *                                                                       
 2510 *                                                                       
 2520 * ----------------=================                                     
 2530 DEFINE SUBROUTINE READ-LDA-CONTENTS                                     
 2540 * ----------------=================                                     
 2550 *                                                                       
 2560 FOR #I = 1 TO C*SRCTX                                                   
 2570 *                                                                       
 2580   MOVE SRCTX(#I) TO #SRCTX                                              
 2590 *                                                                       
 2600   IF #LINE-NUM = H'0000'                    /* header info
 2610     ESCAPE TOP                                                          
 2620   END-IF                                                                
 2630 *                                                                       
 2640   IF #REC-TYPE-1  = 'C'                     /* comment                  
 2650     ESCAPE TOP                                                          
 2660   END-IF                                                                
 2670 *                                                                       
 2680   IF #REC-TYPE-1  = 'D'                                                 
 2690     PERFORM SCAN-FIELD-PORTION   /* ie records that hold field name etc 
 2700   ELSE                                                                  
 2710     IF #L-SCAN-INIT-PORTION      /* any extra info when you .E (edit) a 
 2720       PERFORM SCAN-INIT-PORTION  /* field while in the data-area editor 
 2730     ELSE                         /* eg single/free initialisation       
 2740       ESCAPE BOTTOM                                                     
 2750     END-IF                                                              
 2760   END-IF                                                                
 2770 END-FOR                                                                 
 2780 *                                                                       
 2790 END-SUBROUTINE                                                          
 2800 *
 2810 *                                                                       
 2820 *                                                                       
 2830 * ----------------==================                                    
 2840 DEFINE SUBROUTINE SCAN-FIELD-PORTION                                    
 2850 * ----------------==================                                    
 2860 *                                                                       
 2870 * -------------------------------------------------------------         
 2880 * if the field contain a CONST or INIT on the                           
 2890 * 'Index/Init/EM/Name/Comment' portion then scan this portion           
 2900 * -------------------------------------------------------------         
 2910 *                                                                       
 2920 IF #REC-TYPE-6  = 'I'      /*   CONST or INIT field on comment part     
 2930   IF #REST = SCAN #SEARCH-TEXT                                          
 2940     WRITE  SRCID-OBJECT #VARIABLE #FILLER-22 #REST                      
 2950   END-IF                                                                
 2960 END-IF                                                                  
 2970 *                                                                       
 2980 * ----------------------------------------------------------------      
 2990 * if the field contain any single or free mode initialisation           
 3000 * save the field in a buffer as we may want to look this up later
 3010 * ----------------------------------------------------------------      
 3020 *                                                                       
 3030 IF #REC-TYPE-6  = 'S' /*  Single mode initialisation                    
 3040   OR            = 'F' /*  Free   mode initialisation                    
 3050   MOVE TRUE TO #L-SCAN-INIT-PORTION                                     
 3060   ADD   1                  TO  #INIT-IDX                                
 3070   MOVE  #VARIABLE          TO  #INIT-VAR (#INIT-IDX)                    
 3080   MOVE  #SEQ-INIT-OR-MASK  TO  #INIT-SEQ (#INIT-IDX)                    
 3090 END-IF                                                                  
 3100 *                                                                       
 3110 *                                                                       
 3120 END-SUBROUTINE                                                          
 3130 *                                                                       
 3140 *                                                                       
 3150 *                                                                       
 3160 * ----------------=================                                     
 3170 DEFINE SUBROUTINE SCAN-INIT-PORTION                                     
 3180 * ----------------=================                                     
 3190 *                                                                       
 3200 * -----------------------------------------------------------------
 3210 * if a header record for a single or free field initialisation          
 3220 * lookup the variable name given the sequence number                    
 3230 * -----------------------------------------------------------------     
 3240 *                                                                       
 3250 IF      #REC-TYPE-1 = 'H'                                               
 3260     AND #REC-TYPE-2 = 'S' OR = 'F'                                      
 3270   MOVE #SEQ-FIELD TO #HOLD-SEQ-FIELD                                    
 3280   EXAMINE FULL  #INIT-SEQ (*) FOR FULL #SEQ-FIELD  GIVING INDEX #INDEX  
 3290   IF #INDEX > 0                                                         
 3300     MOVE #INIT-VAR(#INDEX) TO #HOLD-VARIABLE                            
 3310   END-IF                                                                
 3320 END-IF                                                                  
 3330 *                                                                       
 3340 *                                                                       
 3350 * -----------------------------------------------------------------     
 3360 * if the initialised data is matched, write out the results             
 3370 * -----------------------------------------------------------------     
 3380 *                                                                       
 3390 IF #INDEX > 0                                                           
 3400   IF #INITIAL-VALUE = SCAN #SEARCH-TEXT
 3410     WRITE  SRCID-OBJECT #HOLD-VARIABLE #INITIAL-ARRAY #INITIAL-VALUE    
 3420   END-IF                                                                
 3430 END-IF                                                                  
 3440 *                                                                       
 3450 END-SUBROUTINE                                                          
 3460 *                                                                       
 3470 *                                                                       
 3480 *                                                                       
 3490 END