          IDENT  RHAQRM
          TITLE  RHA$INTERFACE TO ROUTE MACRO
          ENTRY  RHPQRM,ICPROUT,RHPPJR
          SYSCOM B1
          LIST   F
*
* RHPQRM, ICPROUT, RHPPJR
*
*    THE PURPOSE OF THIS A170 COMPASS ROUTINE IS TO PROVIDE AN
* INTERFACE BETWEEN A CYBIL PROCEDURE AND THE 170 ROUTE MACRO.
*
*            RHPQRM (ROUTE_PARAMETER_BLOCK)
*
 RHPQRM   BSS    0
 NBESYS   IF     DEF,RA.ORG
          RJ     =XPXSAVE
          EQ     RTE               TO CALL ROUTE

 RHPPJR   BSS    0
 NBESYS   ENDIF
 ICPROUT  RJ     =XPXSAVE

 NBESYS   IF     DEF,RA.ORG
          SX3    1
          SA2    NJNAME            PSEUDO-JSN
          LX3    36D
          IX2    X2+X3             ADD ONE IN BIT 36
 L1       LX3    5
          MI     X3,RESET          IF LEFTMOST, RESET PSEUDO-JSN
          BX5    X2*X3             FIND 40B= DC '5' THIS CHARACTER
          ZR     X5,DONE
          LX3    1                 POSITION TO NEXT CHARACTER
          IX2    X2+X5             ADD ANOTHER 40B
          AX5    5
          IX2    X2+X5             ADD ANOTHER 01B
          EQ     L1
 RESET    SA2    JOBNAME
 DONE     BX7    X2
          SA7    NJNAME
          SA2    X1+3
          MX6    42D
          BX6    -X6*X2
          BX7    X7+X6
          SA7    A2                ROUTE PB FID
 NBESYS   ENDIF
*
 RTE      BX0    X1
          ROUTE  X0,1
*
* RESTORE CYBIL ENVIRONMENT AND RETURN TO CALLER
*
          EQ     =XZSMRRET

 NBESYS   IF     DEF,RA.ORG
 JOBNAME  VFD    42/7LAAAA000,18/0       JOB NAME
 NJNAME   VFD    42/7LAAAA000,18/0       COUNT UP PSEUDO-JSN HERE

 NBESYS   ELSE
          SPACE  3,10
* RHPPJR
*
*    THE PURPOSE OF THIS COMPASS ROUTINE IS TO VERIFY A USER'S
* ACCOUNTING INFO AND ROUTE A PARTNER JOB TO EXECUTE A GET_FILE OR
* REPLACE_FILE.
*
*            RHAPJR (ROUTE_PARAMETER_BLOCK)
*
 RHPPJR   RJ     =XPXSAVE
*
* VERIFY USER ACCOUNTING INFORMATION
*
          SA1    X1
          MX6    42
          BX6    X1*X6
          SX1    1
          BX6    X6+X1
          SA6    FET                   SAVE FILE NAME
          SX6    BUFFER
          SX7    BUFFER+65
          SA6    A6+B1                 SET FIRST
          SA6    A6+B1                 SET IN
          SA6    A6+B1                 SET OUT
          SA7    A6+B1                 SET LIMIT
          READ   FET,RECALL              READ CARDS

          SX6    B0
          SA6    FET
          SA6    A6+B1
          SYSTEM VEJ,RECALL,FET        VERIFY USER INFO

          SA1    FET                   CHECK IF ERROR
          AX1    12
          MX6    6
          BX6    X1*X6
          ZR     X6,ROUTE               ROUTE JOB IF NO ERROR

          LX6    12                    PUT ERROR CODE IN THE
          SA1    =XPARSV               ROUTE PARAMETER BLOCK
          SA2    X1
          BX6    X2+X6
          SA6    X1                     RETURN ERROR CODE
          EQ     =XZSMRRET
*
* RETURN FILE AND CALL 170 ROUTE MACRO
*
ROUTE     BSS
          RETURN FET,R
          SA1    =XPARSV                SET POINTER TO ROUTE FET
          EQ     RTE
*
FET       BSSZ   5
BUFFER    BSSZ   65
NBESYS    ENDIF

          END
