*DECK LFGRDHR 
USETEXT LFGIOD,LFGHDRC,LFGIB
      PROC LFGRDHR(PICBF,WC,BEGADDR,SUCCESS); 
      BEGIN 
*IF DEF,IMS 
# 
**    LFGRDHR - READ HEADER RECORD. 
* 
*     M. E. VATCHER  81/02/23 
* 
*     LFGRDHR READS A MODULE HEADER RECORD FROM THE CURRENT INPUT 
*     FILE AT THE CURRENT POSITION. 
* 
*     PROC LFGRDHR(PICBF,WC,BEGADDR,SUCCESS)
* 
*     ENTRY NONE. 
* 
*     EXIT  PICBF     SET IF THIS IS A PICB 
*           WC        16 BIT WORD COUNT OF DATA IN FOLLOWING RECORD 
*           BEGADDR   BEGINNING ADDRESS 
*           SUCCESS   SUCCESSFUL COMPLETION INDICATOR 
* 
*     METHOD
* 
*     READ A RECORD 
*     SET WORD COUNT
*     SET OR CLEAR PICB INDICATOR 
*     IF ITS NOT A PICB 
*     THEN
*       SET BEGINNING ADDRESS 
* 
# 
*ENDIF
  
# 
****  PROC LFGRDHR - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        ITEM IFET;           # FWA OF INPUT FILE FET                   #
        PROC LFGRDER;        # SEND READ ERROR MESSAGE                 #
        PROC LFGRDSR;        # READ SEQUENTIAL RECORD                  #
        END 
  
# 
****
# 
  
  
      ITEM PICBF B;          # TRUE IF ITS A PICB                      #
      ITEM WC U;             # 16 BIT WORD COUNT                       #
      ITEM BEGADDR U;        # BEGINNING ADDRESS                       #
      ITEM STATIS;
      ITEM SUCCESS B; 
  
      P<HEADER> = LOC(IBUF[0]); 
      SUCCESS = TRUE; 
  
      LFGRDSR(LOC(IFET),STATIS); # READ A HEADER RECORD                #
      IF STATIS NQ RDEOR
      THEN
        BEGIN 
        LFGRDER(STATIS);     # SEND APPROPRIATE MESSAGE TO OUTPUT      #
        SUCCESS = FALSE;
        RETURN;              # ***** EXIT *****                        #
  
        END 
      WC = WCOUNT;           # SET WORD COUNT                          #
      IF NAME1[0] EQ O"120" AND # ASCII "P"                            #
        NAME2A[0] EQ 4 AND NAME2B EQ O"11" AND # ASCII "I"             #
        NAME3[0] EQ O"103" AND # ASCII "C"                             #
        NAME4[0] EQ O"102" #ASCII "B"                                  #
      THEN                   # ITS A PICB                              #
        PICBF = TRUE; 
      ELSE
        PICBF = FALSE;
      IF NOT PICBF
      THEN                   # SET BEGINNING ADDRESS                   #
        BEGIN 
        B<37,5>BEGADDR = PAGER[0];
        B<42,7>BEGADDR = PAGEN[0];
        B<49,11>BEGADDR = PAGED[0]; 
        END 
      END TERM