*DECK C$IOST
          IDENT  C$IOST 
          SST 
          TITLE  C$IOST - INPUT-OUTPUT CRM STATUS RETURNER
* 
          COMMENT  INPUT-OUTPUT CRM STATUS RETURNER 
**        C.IOST - INPUT-OUTPUT CRM STATUS RETURNER 
* 
*         CALLED IN LINE BY ENTER COMPASS C.IOST USING LFN,DN-1,DN-2. 
* 
*                LFN IS FILE TO STATUS (COBOL FILE NAME)
*                DN-1 IS THE COMP-1 ITEM FOR RETURN 
*                DN-2 IS A FLAG FOR TRIVIAL (T) OR FATAL (F)
* 
*                THE RETURN IN DN-1 IS FORMATTED TO LOOK LIKE OCTAL WHEN
*                CONVERTED TO DECIMAL BECAUSE CRM ERRORS ARE LISTED IN
*                OCTAL. 
* 
*CALL IOMICROS
          ENTRY  C.IOST 
 C.IOST   DATA   0
          LX1    60-24       CHECK IF 1ST PARAMETER WORD IS A FILE-NAME 
          MX0    54           POINTER 
          BX2    -X0*X1 
          SX2    X2-44B 
          NZ     X2,C.IOST1  JUMP IF PARAMETER ERROR
          LX1    24          RESTORE X1 
          SA0    X1          FIT PTR SAVED
          FETCH  A0,ES,X1    GET ERROR CODE 
          SX5    X1-777B
          NZ     X5,NTCBER   JP IF NOT A COBOL DETECTED ERROR 
          FETCH  A0,CBER,X1  GET COBOL GENERATED ERROR
          SX1    X1+2400B    BIAS IT
 NTCBER   BSS    0
          MX2    60-3 
          BX7    -X2*X1      GET LOW ORDER OCTAL DIGIT
          SX3    10 
          AX1    3
          BX4    -X2*X1      GET MIDDLE DIGIT 
          AX1    3
          IX4    X4*X3       MIDDLE TIMES 10
          IX7    X4+X7       ADD TO LOW ORDER 
          SX3    100
          IX5    X3*X1       HIGH * 100 
          IX7    X5+X7       FINAL RESULT 
          SA1    A1+B1       GET RETURN PARAM 
          LX1    60-18       CHECK IF 2ND PARAMETER WORD IS A COMP-1
          BX2    -X0*X1       ITEM
          SX2    X2-24B      2 - ALPHANUMERIC, 4 - COMP-1 
          NZ     X2,C.IOST1  JUMP IF PARAMETER ERROR
          LX1    18          RESTORE X1 
          SA7    X1          STORE CODE 
          SA3    A1+B1       GET PARAM FOR FATALITY CODE
          SB2    X3          WORD ADDR
          AX3    30 
          MX2    60-6 
          BX5    -X2*X3      BCP
          AX3    6           CHECK IF SIZE FIELD IN 3RD PARAMETER WORD
          MX4    42           = 1 
          BX4    -X4*X3 
          SX4    X4-1 
          NZ     X4,C.IOST1  JUMP IF SIZE NOT 1 
          SA1    =XC.ERFLG   GET T OR F FROM C$COMIO
          SX4    9
          IX5    X4-X5
          SX4    6
          IX5    X4*X5       GIVES SHIFT
          SB3    X5 
          SA3    B2          GET WORD 
          LX2    B3,X2       POSITION MASK
          LX6    B3,X1       POSITION ERROR FLAG FOR RETURN 
          BX7    X2*X3       MASK OUT CHAR SLOT 
          BX7    X7+X6       PUT IN CHAR
          SA7    A3          STORE RESULT 
          EQ     C.IOST      RETURN 
* 
*                A PARAMETER IS IN ERROR. CALL -C.MSG- TO OUTPUT AN 
*                ERROR MESSAGE. 
 C.IOST1  SA3    =8L-C.IOST-  MESSAGE INSERT
          BX6    X3 
          SA6    =XC.MSINS
          SX1    #PRMERR     MESSAGE NUMBER 
          MX2    1           X2"0, MESSAGE HAS INSERT 
          SA3    C.IOST      GET LINE NUMBER
          MX0    30 
          AX3    30 
          SA3    X3-1 
          SX7    X3 
          SA3    C.IOST2
          BX3    X0*X3
          IX7    X3+X7
          SA7    A3 
          MX3    0           LINE NUMBER IS IN LOWER HALF OF -RJ C.MSG- 
          MX6    0           NO ABORT BY -CBMSG-
 C.IOST2  RJ     =XC.MSG     MESSAGE TO DAYFILE 
 -        VFD    30/0        FILLED IN ABOVE
          EQ     C.IOST      EXIT 
          END 
