perm filename CMS2B[T,LSP] blob sn#649106 filedate 1982-03-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	R T=0.01/0.02 07:09:50
C00004 00003	PL/I OPTIMIZING COMPILE 3.0 PTF 69        TIME: 00.26
C00039 00004	   MARCDO: PROCEDURE OPTIONS (MAIN)
C00062 ENDMK
C⊗;
R; T=0.01/0.02 07:09:50

.λ

DMSLIO740I EXECUTION BEGINS...

1002ad              
2408aklmnopr        
2453abc             
2603abc             
3003abc             
6004adtx            
6505abxyz           
7006adlpst          
TAG          LENGTH          POSITION


001           0013             00000
008           0041             00013
020           0015             00054
050           0021             00069
082           0012             00090
100           0020             00102
245           0024             00122
250           0014             00146
260           0050             00160
300           0031             00210
350           0010             00241
500           0059             00251
650           0014             00310
10aMaisel, Edward.↔
10aTai chi for health.↔
0 aNew York,bHolt, Rinehart and Winstonc1972~↔
  axi, 212 p.billus.c24 cm.↔
 0aExercise.∧
R; T=1.19/2.43 07:10:41

.λ
PL/I OPTIMIZING COMPILE 3.0 PTF 69        TIME: 00.26
.18    DATE: 22 FEB 82          PAGE   1
OPTIONS SPECIFIED
OP OPT(2) F(I) S AG C GS MI('|') IS LC(60) NEST STMT NNUM LMSG STG;
OPTIONS USED

AGGREGATE      NOATTRIBUTES   CHARSET(60,EBCDIC)
COMPILE        NOCOUNT        FLAG(I)

GOSTMT         NODECK         LINECOUNT(60)
INSOURCE       NOESD          MARGINI('|')
LMESSAGE       NOFLOW         MARGINS(2,72,0)
NEST           NOGONUMBER     OPTIMIZE(TIME)
OBJECT         NOIMPRECISE    SEQUENCE(73,80)
OPTIONS        NOINCLUDE      SIZE(645784)
SOURCE         NOINTERRUPT    NOSYNTAX(S)
STMT           NOLIST         TERMINAL(NOAGGREGATE,
STORAGE        NOMACRO                 NOATTRIBUTES,
               NOMAP                   NOESD,
               NOMDECK                 NOINSOURCE,
               NONUMBER                NOLIST,

               NOOFFSET                NOMAP,
               NOXREF                  NOOFFSET,
                                       NOOPTIONS,
                                       NOSOURCE,
                                       NOSTORAGE,
                                       NOXREF)
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   2
                    SOURCE LISTING
    STMT LEV NT

       1      0  |  MARCDO: PROCEDURE OPTIONS (MAIN);                          
         |CMS00010
                 |    /*THIS PROGRAM READS A LIBRARY INSTRUCTION DECKLET, PRINTS
         |CMS00020
                 |      IT OUT FROM THE STRUCTURE WHERE IT HAS BEEN STORED, AND
         |CMS00030
                 |      PRINTS OUT THE RECORD DIRECTORY*/                      
         |CMS00040
                 |                                                             
         |CMS00050
       2   1  0  |    DECLARE                                                  
         |CMS00060
                 |      1 DECKLET,                                             
         |CMS00070

                 |       2 CARDLET,   /*SET OF MARC SPECS*/                    
         |CMS00080
                 |        3 TAG CHAR(3),                                       
         |CMS00090
                 |        3 SIZE CHAR(1),                                      
         |CMS00100
                 |        3 SUBF CHAR(16) VARYING,                             
         |CMS00110
                 |      EOF BIT(1) INIT('0'B),                                 
         |CMS00120
                 |      RECS FILE RECORD SEQUENTIAL, /*FILE CONTAINING DECKLETS*
/        |CMS00130
                 |      (SYSIN, SYSPRINT) FILE STREAM,                         
         |CMS00140
                 |      SUBSTR BUILTIN,                                        
         |CMS00150
                 |       INDEX BUILTIN,                                        
         |CMS00160
                 |      MARC FILE RECORD SEQUENTIAL;                           
         |CMS00170
       3   1  0  |    CALL DECKIT; /*ROUTINE TO READ IN AND PRINT OUT DECKLET*/
         |CMS00180
       4   1  0  |    CALL MARCDIR; /*ROUTINE TO EXTRACT RECORD DIRECTORY*/    
         |CMS00190
       5   1  0  |    RETURN; /*RETURN CONTROL TO CMS*/                        
         |CMS00200
                 |                                                             
         |CMS00210
       6   1  0  |   DECKIT: PROCEDURE;                                        
         |CMS00220
                 |    /*THIS ROUTINE READS THE INFORMATION FROM THE DECKLET INTO
         |CMS00230
                 |      A STRUCTURE AND THEN PRINTS IT OUT*/                   
         |CMS00240
       7   2  0  |    ON ENDFILE (SYSIN) EOF = '1'B;                           
         |CMS00250
       8   2  0  |    OPEN FILE (RECS) OUTPUT;                                 
         |CMS00260
                 |                                                             
         |CMS00270
       9   2  0  |    DO WHILE (↑EOF);                                         
         |CMS00280
      10   2  1  |       GET SKIP EDIT (DECKLET.CARDLET) (A(3),A(1),A(16));    
         |CMS00290
      11   2  1  |      IF EOF THEN LEAVE;                                     
         |CMS00300
      12   2  1  |       WRITE FILE (RECS) FROM (DECKLET); /*CREATE RECORD*/   
         |CMS00310
      13   2  1  |    END;                                                     
         |CMS00320
                 |                                                             
         |CMS00330
      14   2  0  |    CLOSE FILE (RECS);                                       
         |CMS00340
                 |                                                             
         |CMS00350
      15   2  0  |    EOF = '0'B; /*RESET END FLAG*/                           
         |CMS00360
      16   2  0  |    ON ENDFILE (RECS) EOF = '1'B;                            
         |CMS00370
      17   2  0  |    OPEN FILE (RECS) INPUT; /*OPEN FILE OF SPECS FOR INPUT*/ 
         |CMS00380
      18   2  0  |    DO WHILE (↑EOF);                                         
         |CMS00390
      19   2  1  |       READ FILE (RECS) INTO (DECKLET.CARDLET);              
         |CMS00400
      20   2  1  |      IF EOF THEN LEAVE;                                     
         |CMS00410
      21   2  1  |      PUT SKIP EDIT (DECKLET.CARDLET) (A);                   
         |CMS00420
      22   2  1  |    END;                                                     
         |CMS00430
      23   2  0  |    CLOSE FILE (RECS);                                       
         |CMS00440
      24   2  0  |    RETURN; /*RETURN TO MAIN PROGRAM*/                       
         |CMS00450
      25   2  0  |   END DECKIT;                                               
         |CMS00460
                 |                                                             
         |CMS00470
      26   1  0  |    MARCDIR: PROCEDURE;                                      
         |CMS00480
                 |     /*THIS ROUTINE EXTRACTS AND PRINTS OUT THE MARC RECORD  
         |CMS00490
                 |       DIRECTORY AND SUBFIELDS INDICATED BY DECKLET*/        
         |CMS00500
                 |                                                             
         |CMS00510
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   3
    STMT LEV NT
      27   2  0  |     DECLARE                                                 
         |CMS00520
                 |       1 DECKLET,                                            
         |CMS00530
                 |        2 CARDLET,   /*SET OF MARC SPECS*/                   
         |CMS00540
                 |         3 TAG CHAR(3),                                      
         |CMS00550
                 |         3 SIZE CHAR(1),                                     
         |CMS00560
                 |         3 SUBF CHAR(16) VARYING,                            
         |CMS00570
                 |       (I,J,K,L) FIXED BIN (15),                             
         |CMS00580
                 |       AREA CHAR(2000) VARYING,                              
         |CMS00590
                 |       FIELD(50) CHAR(12),                                   
         |CMS00600
                 |       PRINT BIT(1),                                         
         |CMS00610
                 |       LENGTH FIXED BIN(15),                                 
         |CMS00620
                 |       START FIXED BIN(15),                                  
         |CMS00630
                 |       DIR CHAR(500) VARYING; /*EXTRACTED DIRECTORY*/        
         |CMS00640
      28   2  0  |     OPEN FILE (MARC) INPUT; /*OPEN THE FILE OF MARC RECS FOR
INPUT*/  |CMS00650
      29   2  0  |     EOF = '0'B;                                             

         |CMS00660
                 |                                                             
         |CMS00670
      30   2  0  |     PUT SKIP EDIT ('TAG','LENGTH','POSITION') (A(3),X(10),A(6
),       |CMS00680
                 |                     X(10),A(8));                            
         |CMS00690
                 |                                                             
         |CMS00700
      31   2  0  |     DO;/*TRY THIS JUST ONCE*/                               
         |CMS00710
      32   2  1  |       PUT SKIP (2);                                         
         |CMS00720
      33   2  1  |       READ FILE (MARC) INTO (AREA);                         
         |CMS00730
      34   2  1  |       J = SUBSTR(AREA, 13, 5); /*GET STARTING POS. OF CONTROL
         |CMS00740
                 |                                  FIELDS*/                   
         |CMS00750
      35   2  1  |       DIR = SUBSTR(AREA, 25, J-25); /*EXTRACT DIRECTORY*/   
         |CMS00760
      36   2  1  |       L = 1;                                                
         |CMS00770
      37   2  1  |        PUT SKIP DATA (J);                                   
         |CMS00780
      38   2  1  |       CHOP: /*DIVIDE INTO BLOCKS & PRINT*/                  
         |CMS00790
                 |         DO K = 1 TO (J-25)/12;                              
         |CMS00800
      39   2  2  |         CALL PRINTFRM (SUBSTR(DIR,L,3),SUBSTR(DIR,L+3,4),   
         |CMS00810
                 |                      SUBSTR(DIR,L+7,5));                    
         |CMS00820
      40   2  2  |         FIELD(K) = SUBSTR(DIR,L,12);/*START FILLING ARRAY   
         |CMS00830
                 |                    WITH FIELDS*/                            
         |CMS00840
      41   2  2  |          PUT SKIP DATA (FIELD(K));                          

         |CMS00850
      42   2  2  |          PUT SKIP DATA (DIR);                               
         |CMS00860
      43   2  2  |         L = L + 12; /*SKIP TO NEXT 12 CHARACTERS*/          

         |CMS00870
      44   2  2  |       END CHOP;                                             
         |CMS00880
      45   2  1  |       CALL FLDPRT (FIELD,DECKLET,K,PRINT,J,AREA);           
         |CMS00890
      46   2  1  |      END;                                                   
         |CMS00900
      47   2  0  |      CLOSE FILE (MARC);                                     
         |CMS00910
      48   2  0  |     RETURN;/*RETURN TO MAIN PROGRAM*/                       
         |CMS00920
      49   2  0  |     END MARCDIR;                                            
         |CMS00930
                 |                                                             
         |CMS00940
                 |        /*SUBROUTINE TO FORMAT DIRECTORY*/                   
         |CMS00950
      50   1  0  |        PRINTFRM: PROCEDURE (TAG,LEN,POS);                   
         |CMS00960
      51   2  0  |          DCL                                                
         |CMS00970
                 |           TAG CHAR (3),                                     
         |CMS00980
                 |           LEN CHAR (4),                                     
         |CMS00990
                 |           POS CHAR (5);                                     
         |CMS01000
                 |                                                             
         |CMS01010
      52   2  0  |        PUT SKIP EDIT (TAG,LEN,POS)(A(3), X(11),A(4),X(13),A(5
));      |CMS01020
      53   2  0  |        RETURN;                                              
         |CMS01030
      54   2  0  |        END PRINTFRM;                                        
         |CMS01040
                 |                                                             
         |CMS01050
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   4
    STMT LEV NT
                 |        /*SUBROUTINE TO PRINT OUT FIELDS LISTED IN DECKLET*/ 
         |CMS01060
      55   1  0  |        FLDPRT: PROCEDURE (FIELD,DECKLET,K,PRINT,J,AREA);    
         |CMS01070
      56   2  0  |          DECLARE                                            
         |CMS01080
                 |           1 DECKLET CONNECTED,                              

         |CMS01090
                 |            2 CARDLET,   /*SET OF MARC SPECS*/               
         |CMS01100
                 |             3 TAG CHAR(3),                                  
         |CMS01110
                 |             3 SIZE CHAR(1),                                 
         |CMS01120
                 |             3 SUBF CHAR(16) VARYING,                        
         |CMS01130
                 |           FIELD(*) CHAR(12),                                
         |CMS01140
                 |           K FIXED BIN(15),                                  
         |CMS01150

                 |           J FIXED BIN(15),                                  
         |CMS01160
                 |            START FIXED BIN(15),                             
         |CMS01170
                 |            LENGTH FIXED BIN(15),                            
         |CMS01180
                 |            AREA CHAR(2000) VARYING,                         
         |CMS01190
                 |            N FIXED BIN(15);                                 
         |CMS01200
                 |                                                             
         |CMS01210
      57   2  0  |            EOF = '0'B;                                      
         |CMS01220
      58   2  0  |           N = 1;                                            
         |CMS01230
      59   2  0  |          ON ENDFILE (RECS) EOF = '1'B;                      
         |CMS01240
      60   2  0  |          OPEN FILE (RECS) INPUT;                            
         |CMS01250

      61   2  0  |           PUT SKIP DATA (FIELD(K));                         
         |CMS01260
                 |                                                             
         |CMS01270
      62   2  0  |          DO WHILE (↑EOF);                                   
         |CMS01280
      63   2  1  |           READ FILE (RECS) INTO (DECKLET.CARDLET);          
         |CMS01290
      64   2  1  |            PUT SKIP DATA (SIZE);                            
         |CMS01300
      65   2  1  |           IF EOF THEN LEAVE;                                
         |CMS01310

      66   2  1  |              DO WHILE N < K;                                
         |CMS01320
      67   2  2  |                PUT SKIP DATA (TAG);                         

         |CMS01330
      68   2  2  |                PUT SKIP DATA (FIELD(N));                    
         |CMS01340
      69   2  2  |                IF (TAG = SUBSTR(FIELD(N),1,3) THEN          
         |CMS01350
                 |                  DO;                                        
         |CMS01360
      70   2  2  |                   START = SUBSTR(FIELD(K),8,5) + J + 1;         
         |CMS01370
      71   2  2  |                   LENGTH = SUBSTR(FIELD(K),4,4);            
         |CMS01380
      72   2  2  |                   PUT SKIP EDIT (SUBSTR(AREA,START,LENGTH)  

         |CMS01390
                 |                                  (A(LENGTH));               
         |CMS01400
      73   2  2  |                  END;                                       
         |CMS01410
      74   2  1  |             END;                                            
         |CMS01420

      75   2  0  |          END;                                               
         |CMS01430
      76   1  0  |         CLOSE FILE (RECS);                                  
         |CMS01440
      77   1  0  |       RETURN;                                               
         |CMS01450
      78   1  0  |       END FLDPRT;                                           
         |CMS01460
      79   1  0  |   END MARCDO;                                               
         |CMS01470
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   5
                                       AGGREGATE LENGTH TABLE
DCL NO.   IDENTIFIER                          LVL     DIMS      OFFSET  ELEMENT
   TOTAL
                                                                         LENGTH.
    LENGTH.

2         DECKLET                               1                             22
         22
          CARDLET                               2                             22
         22
          TAG                                   3                              3
          SIZE                                  3                    3         1
          SUBF                                  3                    4        18
27        DECKLET                               1                             22
         22
          CARDLET                               2                             22
         22
          TAG                                   3                              3
          SIZE                                  3                    3         1
          SUBF                                  3                    4        18
56        DECKLET                               1                          PARAM
      PARAM
          CARDLET                               2                          PARAM
      PARAM
          TAG                                   3                          PARAM
          SIZE                                  3                    3     PARAM
          SUBF                                  3                    4     PARAM
27        FIELD                                          1                    12
        600
56        FIELD                                          1                    12
      PARAM
                                                           SUM OF CONSTANT LENGT

HS      644
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   6

                    STORAGE REQUIREMENTS
BLOCK, SECTION OR STATEMENT     TYPE                  LENGTH   (HEX)    DSA SIZE
   (HEX)
*MARCDO1                        PROGRAM CSECT           3416     D58
*MARCDO2                        STATIC CSECT            1620     654
MARCDO                          PROCEDURE BLOCK          178      B2         272
     110
DECKIT                          PROCEDURE BLOCK          622     26E         328
     148
7                               ON UNIT                  124      7C         232
      E8
16                              ON UNIT                  124      7C         232
      E8
MARCDIR                         PROCEDURE BLOCK         1120     460        3576
     DF8
PRINTFRM                        PROCEDURE BLOCK          296     128         304
     130
FLDPRT                          PROCEDURE BLOCK          824     338         384
     180
59                              ON UNIT                  124      7C         232
      E8
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   7
COMPILER DIAGNOSTIC MESSAGES
ERROR ID L   STMT    MESSAGE DESCRIPTION

SEVERE AND ERROR DIAGNOSTIC MESSAGES


IEL0280I E   66      LEFT PARENTHESIS ASSUMED AFTER 'DO WHILE'.
IEL0400I E   66      RIGHT PARENTHESIS ASSUMED AFTER 'DO WHILE N < K'.
IEL0247I S   69      INVALID SYNTAX IN 'IF' STATEMENT EXPRESSION.    '(TAG = SUB
STR(FIELD(N),1,3) THEN
                                           DO' HAS BEEN REPLACED BY 1.
IEL0271I S   69      KEYWORD 'THEN' ASSUMED AFTER 'DO' IN 'IF' STATEMENT.
IEL0400I E   69      RIGHT PARENTHESIS ASSUMED AFTER 'UBSTR(FIELD(N),1,3)'.
IEL0306I S   72      EDIT DATA LIST HAS NO MATCHING FORMAT LIST AFTER ',LENGTH)
(A(LENGTH))'.    'A' FORMAT ASSUMED.
IEL0400I E   72      RIGHT PARENTHESIS ASSUMED AFTER ',LENGTH) (A(LENGTH))'.
IEL0500I S   72      CONFLICT BETWEEN USE OF 'SUBSTR' AS 'ENTRY' AND ITS DECLARE
D ATTRIBUTES.    STATEMENT IGNORED.
IEL0503I E   72      IDENTIFIER 'A' IS NOT DECLARED.    EXTERNAL ENTRY ASSUMED.
IEL0268I S   78      LABEL REFERENCED BY 'END' STATEMENT CANNOT BE MATCHED.    R
EFERENCE IGNORED.
IEL0289I S   78      LOGICAL END OF PROGRAM FOUND BEFORE END OF SOURCE TEXT.   
STATEMENT IGNORED.


WARNING DIAGNOSTIC MESSAGES

IEL0916I W   1       ITEM(S) 'DECKLET.CARDLET.SIZE','DECKLET.CARDLET.TAG','DECKL
ET.CARDLET.SUBF' MAY BE UNINITIALIZED
                     WHEN USED IN THIS BLOCK.
IEL0916I W   26      ITEM(S) 'PRINT','DECKLET.CARDLET.TAG','DECKLET.CARDLET.SUBF
','FIELD','DECKLET.CARDLET.SIZE' MAY BE
                     UNINITIALIZED WHEN USED IN THIS BLOCK.
IEL0671I W   45      ARGUMENT NUMBER 4 TO ENTRY 'FLDPRT' DOES NOT MATCH ITS CORR
ESPONDING PARAMETER OR IS AN
                     ISUB-DEFINED ARRAY.    A DUMMY ARGUMENT HAS BEEN CREATED.
IEL0768I W   69      CONSTANT SPECIFIED WHERE EXPRESSION EXPECTED.    FLOW OF CO
NTROL WILL BE UNCONDITIONAL.

IEL0914I W   76, 77    STATEMENT MAY NEVER BE EXECUTED.
PL/I OPTIMIZING COMPILER           MARCDO: PROCEDURE OPTIONS (MAIN);           
                                PAGE   8
ERROR ID L   STMT    MESSAGE DESCRIPTION

COMPILER INFORMATORY MESSAGES

IEL0533I I           NO 'DECLARE' STATEMENT(S) FOR 'A'.
IEL0541I I   1, 6, 7, 16, 26, 50, 55, 59    'ORDER' OPTION APPLIES TO THIS BLOCK
.    OPTIMIZATION MAY BE INHIBITED.
IEL0906I I   34, 70, 71    DATA CONVERSION WILL BE DONE BY SUBROUTINE CALL.
IEL0534I I   55      NO 'DECLARE' STATEMENT(S) FOR PARAMETER(S) 'PRINT'.

END OF COMPILER DIAGNOSTIC MESSAGES
COMPILE TIME    0.04 MINS        SPILL FILE:     0 RECORDS, SIZE  3491


R; T=0.21/1.29 00:44:04

.λ

   MARCDO: PROCEDURE OPTIONS (MAIN);
     /*THIS PROGRAM READS A LIBRARY INSTRUCTION DECKLET, PRINTS
       IT OUT FROM THE STRUCTURE WHERE IT HAS BEEN STORED, AND
       PRINTS OUT THE RECORD DIRECTORY*/

     DECLARE
       1 DECKLET,

        2 CARDLET,   /*SET OF MARC SPECS*/
         3 TAG CHAR(3),
         3 SIZE CHAR(1),
         3 SUBF CHAR(16) VARYING,
         3 SUBF CHAR(16) VARYING,
       RECS FILE RECORD SEQUENTIAL, /*FILE CONTAINING DECKLETS*/
       (SYSIN, SYSPRINT) FILE STREAM,
       SUBSTR BUILTIN,
        INDEX BUILTIN,
       MARC FILE RECORD SEQUENTIAL;
     CALL DECKIT; /*ROUTINE TO READ IN AND PRINT OUT DECKLET*/
     CALL MARCDIR; /*ROUTINE TO EXTRACT RECORD DIRECTORY*/
     RETURN; /*RETURN CONTROL TO CMS*/

    DECKIT: PROCEDURE;
     /*THIS ROUTINE READS THE INFORMATION FROM THE DECKLET INTO
       A STRUCTURE AND THEN PRINTS IT OUT*/
     ON ENDFILE (SYSIN) EOF = '1'B;
     OPEN FILE (RECS) OUTPUT;

     DO WHILE (↑EOF);
        GET SKIP EDIT (DECKLET.CARDLET) (A(3),A(1),A(16));
       IF EOF THEN LEAVE;
        WRITE FILE (RECS) FROM (DECKLET); /*CREATE RECORD*/
     END;

     CLOSE FILE (RECS);

     EOF = '0'B; /*RESET END FLAG*/
     ON ENDFILE (RECS) EOF = '1'B;
     OPEN FILE (RECS) INPUT; /*OPEN FILE OF SPECS FOR INPUT*/
     DO WHILE (↑EOF);
        READ FILE (RECS) INTO (DECKLET.CARDLET);
       IF EOF THEN LEAVE;
       PUT SKIP EDIT (DECKLET.CARDLET) (A);
     END;

     CLOSE FILE (RECS);
     RETURN; /*RETURN TO MAIN PROGRAM*/
    END DECKIT;

     MARCDIR: PROCEDURE;
      /*THIS ROUTINE EXTRACTS AND PRINTS OUT THE MARC RECORD
        DIRECTORY AND SUBFIELDS INDICATED BY DECKLET*/

      DECLARE
        1 DECKLET,
         2 CARDLET,   /*SET OF MARC SPECS*/
          3 TAG CHAR(3),
          3 SIZE CHAR(1),
          3 SUBF CHAR(16) VARYING,
        (I,J,K,L) FIXED BIN (15),
        AREA CHAR(2000) VARYING,
        FIELD(50) CHAR(12),

        PRINT BIT(1),
        LENGTH FIXED BIN(15),
        START FIXED BIN(15),
        DIR CHAR(500) VARYING; /*EXTRACTED DIRECTORY*/
      OPEN FILE (MARC) INPUT; /*OPEN THE FILE OF MARC RECS FOR INPUT*/
      EOF = '0'B;

      PUT SKIP EDIT ('TAG','LENGTH','POSITION') (A(3),X(10),A(6),
                      X(10),A(8));

      DO;/*TRY THIS JUST ONCE*/
        PUT SKIP (2);
        READ FILE (MARC) INTO (AREA);
        J = SUBSTR(AREA, 13, 5); /*GET STARTING POS.
        CHOP: /*DIVIDE INTO BLOCKS & PRINT*/
          DO K = 1 TO (J-25)/12;

          CALL PRINTFRM (SUBSTR(DIR,L,3),SUBSTR(DIR,L+3,4),
                       SUBSTR(DIR,L+7,5));
          FIELD(K) = SUBSTR(DIR,L,12);/*START FILLING ARRAY
                     WITH FIELDS*/
           PUT SKIP DATA (FIELD(K));
           PUT SKIP DATA (DIR);
          L = L + 12; /*SKIP TO NEXT 12 CHARACTERS*/
        END CHOP;
        CALL FLDPRT (FIELD,DECKLET,K,PRINT,J,AREA);
       END;
       CLOSE FILE (MARC);
      RETURN;/*RETURN TO MAIN PROGRAM*/
      END MARCDIR;


         /*SUBROUTINE TO FORMAT DIRECTORY*/
         PRINTFRM: PROCEDURE (TAG,LEN,POS);
           DCL
            TAG CHAR (3),
            LEN CHAR (4),
            POS CHAR (5);

         PUT SKIP EDIT (TAG,LEN,POS)(A(3), X(11),A(4),X(13),A(5));
         RETURN;
         END PRINTFRM;

         /*SUBROUTINE TO PRINT OUT FIELDS LISTED IN DECKLET*/
         FLDPRT: PROCEDURE (FIELD,DECKLET,K,PRINT,J,AREA);
           DECLARE
            1 DECKLET CONNECTED,
             2 CARDLET,   /*SET OF MARC SPECS*/

              3 TAG CHAR(3),
              3 SIZE CHAR(1),
              3 SUBF CHAR(16) VARYING,
            FIELD(*) CHAR(12),
            K FIXED BIN(15),
            J FIXED BIN(15),
             POS FIXED BIN(15),
             START FIXED BIN(15),
             LENGTH FIXED BIN(15),
             AREA CHAR(2000) VARYING,
            N FIXED BIN(15);
                     
           EOF = '0'B;
           N = 1;
           ON ENDFILE (RECS) EOF = '1'B;
           OPEN FILE (RECS) INPUT;
            PUT SKIP DATA (FIELD(K));


           DO WHILE (↑EOF);
            READ FILE (RECS) INTO (DECKLET.CARDLET);
             PUT SKIP DATA (SIZE);
            IF EOF THEN LEAVE;
              DO WHILE N < K;
                PUT SKIP DATA (TAG);
                PUT SKIP DATA (FIELD(N));
                IF (TAG = SUBSTR(FIELD(N),1,3)
                  DO;
                    START = SUBSTR(FIELD(N),8,5) + J;
                    LENGTH = SUBSTR(FIELD(N),4,4);              
                    PUT SKIP EDIT (SUBSTR(AREA,START,LENGTH)) 
                                  (A(LENGTH));
                  END;
              END;
           END;
          CLOSE FILE (RECS);
        RETURN;
        END FLDPRT;

           /*THIS PROCEDURE COMPARES THE TAG FROM DECKLET
           WITH THE TAGS IN THE FIELD ARRAY. IF IDENTIFICATION
           IS POSITIVE IT SIGNALS THE PROGRAM TO PRINT OUT THE
           FIELD*/
           MATCH: PROCEDURE (FIELD,DECKLET,K,PRINT);
             DECLARE

                1 DECKLET CONNECTED,
                  2 CARDLET,   /*SET OF MARC SPECS*/
                  3 TAG CHAR(3),
                  3 SIZE CHAR(1),
                  3 SUBF CHAR(16) VARYING,
               FIELD(*) CHAR(12),
               K FIXED BIN(15),
               J FIXED BIN(15),
               START FIXED BIN(15),
               LENGTH FIXED BIN(15),
               AREA CHAR(2000) VARYING,
               TRUE BIT(1) INIT ('1'B),
               FALSE BIT(1) INIT ('0'B),
               PRINT BIT(1);

           /*INITIALIZE VARIABLES*/
            N=1;
            GOGOGO = TRUE;
            PRINT = FALSE;
             PUT SKIP DATA (TAG);

            DO WHILE ((N <= K) & GOGOGO);
              IF (TAG = SUBSTR(FIELD(N),1,3)) THEN
                DO;
                  GOGOGO = FALSE;/*FLAG TO STOP COMPARISON*/
                  PRINT = TRUE;/*FLAG TO PRINT FIELD*/
                END;
               N = N + 1;
            END;
            RETURN;
            END MATCH;
    END MARCDO;