Retro1.org codex

*DECK LFGRDER 
USETEXT LFGIOD,LFGFN
      PROC LFGRDER(STATIS); 
      BEGIN 
*IF DEF,IMS 
# 
**    LFGRDER - PRINT READ ERROR MESSAGE. 
* 
*     M. E. VATCHER  81/02/23 
* 
*     LFGRDER WRITES A READ ERROR MESSAGE TO THE OUTPUT FILE. 
* 
*     PROC LFGRDER(STATIS)
* 
*     ENTRY STATIS    ERROR CODE
* 
*     EXIT  NONE. 
* 
*     METHOD
* 
*     DEPENDING ON THE ERROR CODE, ONE OF THREE ERROR MESSAGES
*     IS SENT TO THE OUTPUT FILE. 
* 
# 
*ENDIF
 
# 
****  PROC LFGRDER - XREF LIST BEGIN. 
# 
 
      XREF
        BEGIN 
        ITEM OUTPUT U;       # FWA OF OUTPUT FILE FET                  #
        PROC WRITEC;         # WRITE LINE TO CIO BUFFER                #
        PROC WRITER;         # WRITE RECORD                            #
        FUNC XCDD C(10);     # CONVERT INTEGER TO DECIMAL DISPLAY CODE #
        FUNC XSFW C(10);     # SPACE FILL WORD                         #
        END 
 
# 
****
# 
 
 
      ITEM STATIS U;
      ITEM TEMP C(10);
 
      ARRAY BF [0:0] S(5);
        BEGIN 
        ITEM BF1 C(0,0,44) =
          ["HEADER RECORD TOO LARGE IN XXXXXXX FILE NNN."]; 
        ITEM BFLFN C(2,42,7); 
        ITEM BFFILE C(4,0,3); 
        ITEM BFZ U(4,24,36) = [ 0 ];
        END 
 
      ARRAY PEOF [0:0] S(3);
        BEGIN 
        ITEM PEOF1 C(0,0,26) =
          [" PREMATURE EOF ON XXXXXXX."]; 
        ITEM PEOFLFN C(1,48,7); 
        ITEM PEOFZ U(2,42,18) = [ 0 ];
        END 
 
      ARRAY PEOI [0:0] S(3);
        BEGIN 
        ITEM PEOI1 C(0,0,26) =
          [" PREMATURE EOI ON XXXXXXX."]; 
        ITEM PEOILFN C(1,48,7); 
        ITEM PEOIZ U(2,42,18) = [ 0 ];
        END 
 
      IF STATIS EQ RDBFULL
      THEN                   # HEADER RECORD TOO LARGE                 #
        BEGIN 
        TEMP = XSFW(FNAME[LFN]);
        BFLFN[0] = C<0,7>TEMP;
        TEMP = XCDD(FILENUM); 
        BFFILE = C<7,3>TEMP;
        WRITEC(OUTPUT,BF);
        WRITER(OUTPUT,"R"); 
        END 
      ELSE IF STATIS EQ RDEOF 
      THEN                   # PREMATURE EOF                           #
        BEGIN 
        TEMP = XSFW(FNAME[LFN]);
        PEOFLFN[0] = C<0,7>TEMP;
        WRITEC(OUTPUT,PEOF);
        WRITER(OUTPUT,"R"); 
        END 
      ELSE IF STATIS EQ RDEOI 
      THEN                   # PREMATURE EOI                           #
        BEGIN 
        TEMP = XSFW(FNAME[LFN]);
        PEOILFN = C<0,7>TEMP; 
        WRITEC(OUTPUT,PEOI);
        WRITER(OUTPUT,"R"); 
        END 
      END TERM