*COMDECK /RPEDSQ/ 
 36B      PUT.IN    0 
          SET.RM    ERP,0          CLEAR ERROR POINTER
* CALL /DPEDSQ/ 
*CALL /DPEDSQ/
*                                  IF EO=D, DROP BAD DATA AND POSITION
*                                  TO START OF NEXT GO OF RECORD IF POS.
*                                  TAKE ERROR EXIT. 
          F.RM      BT,B2 
          SB5       #IT#
          EQ        B2,B5,IBPAR    IF I-BLOCKS
          SB5       #ET#
          EQ        B2,B5,EKBPAR   IF E-BLOCKS
          SB5       #KT#
          EQ        B2,B5,EKBPAR   IF K-BLOCKS
*         MUST BE BT=C - CAN ONLY RECOVER R AND Z RECORDS OR IF 
*                           MBL = PRUSIZ W RECORDS. 
          SB5       #WT#
          EQ        B2,B5,WRPAR    IF W-RECORDS 
          SB5       #RT#
          EQ        B2,B5,RZRPAR   IF R-RECORDS 
          SB5       #ZT#
          NE        B2,B5,ABTPAR   IF NOT RT=W/R/Z, TAKE ERROR EXIT-F 
 RZRPAR   BSS       0 
* CALL /RSPTDSQ/
*CALL /RSPTDSQ/ 
          IS.IN 
 N137     SET.RM    DEL,1          SET DEL FLAG TO SKIP PIECE OF RECORD 
          SET.RM    GSF,0          SET FLAG TO SKIP 
 PRTN     BSS       0 
          F.RM      BT,X2,-#KT#    IF PARITY BLOCK IS K TYPE
          NZ        X2,RTN
          F.RM      RB,X2          RE-INTIALIZE KRN = RB
          SET.RM    KRN,X2
RTN       BSS       0 
          SET.RM    GEN,137B
          F.RM      RTJG,B6 
          EQ        =XAINI$SQ 
* 
*         DROP PARITY ERRORS FOR E AND K BLOCKS 
* 
 EKBPAR   BSS       0 
          SET.RM    IN,B3          SET IN=OUT 
          SET.RM    FP,#EOR#       SET FP=EOR 
 E137     BX7       X"XREG.RM"     SAVE FIT WORD
          SA7       A0+"FWRD.RM"
          CRMEP                    TAKE ERROR EXIT
* 
*         DROP PARITY ERROR FOR I-BLOCK 
* 
 WRPAR    BSS       0 
 IBPAR    BSS       0 
          SET.RM    IN,B3          RESET IN TO OUT
          SX3       0 
          SX2       10B 
          OFF.RM    SOL,INSL
          SX3       10
          SX2       260B
 INSL     BSS       0 
          SET.RM    BL,X3          RESET BL 
          SYSY      X2,R           READ NEXT BLOCK
          SX1       34000B
          SA2       A0
          BX3       X1*X2 
          NZ        X3,PERR        IF ERROR IN READ, JUMP 
          F.RM      IN,B2 
          EQ        B2,B3,ABTPAR   IF IN DONT MOVE, ABORT 
          F.RM      SOL,B2
          BUFINC    B,3,2,7        INCREMENT OUT IF S/L TAPE
          SB3       X7
          F.RM      BT,X2,-#IT# 
          NZ        X2,WPAR        IF NOT BT=I - MUST BE BT=C MBL=PRUSIZ
          SA3       B3             PICK UP I-BLOCK CONTROL WORD 
          SB2       X3             PICK UP OFFSET 
          SX3       X3
          SX2       B2+B2 
          LX3       3 
          IX2       X2+X3          BL IN CHAR 
          INC.RM    BL,X2          INCREMENT BL 
          BUFINC    B,2,3,2        INCREMENT OUT BY OFFSET
          SB3       X2
 WPAR     BSS       0 
          SET.RM    OUT,B3         SAVE NEW OUT POINTER 
          SA1       B3             PICK UP W-CONTROL WORD 
          LX1       59-42 
          NG        X1,N137        IF NOT START OF RECORD 
          EQ        E137           ELSE TAKE ERROR EXIT 
 PERR     BSS       0 
          SX2       X1-4000B
          ZR        X2,IBPAR       IF ANOTHER PARITY ERROR
          SX2       X2-10000B 
          ZR        X2,IBPAR       OR PE AND DCE, TRY AGAIN 
          SX6       721B
          BX7       X"XREG.RM"
          SA7       A0+"FWRD.RM"
          EQ        =XERR$RM       ELSE, GIVE 721 ERROR 
* 
*         ACCEPT BAD DATA AS GOOD - WISH LUCK 
* 
 ACPTDAT  BSS       0 
          SET.RM    OUT,B3
          SET.RM    IPF,1           SET INTERNAL PARITY FLAG
          EQ        PRTN
* END /RPEDSQ/
