*DECK PCM00 
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMCCAE 
USETEXT COMQDEF 
USETEXT COMQCAF 
USETEXT COMQFIL 
USETEXT COMQDSP 
USETEXT COMQNET 
    PROC PCM00( ERTERR, IRTERR, SRTERR ); 
      BEGIN #PCM00# 
# 
**    PCM00 - PROCESS ATTRIBUTES RECIEVED ON RFT. 
* 
*     ENTRY FILERMH = REMOTE HOST TYPE RECEIVED ON RFT. 
*           FILEDDC = DD RECEIVED.
*           FILEOTY = OUTPUT DEVICE TYPE. 
*           FILEIRT = FWA OF IMPLICIT TEXT BUFFER.
*           FILEERT = FWA OF EXPLICIT TEXT BUFFER.
*           FILESRT = FWA OF SYSTEM TEXT BUFFER.
* 
*     EXIT  DSP PARAMETERS SET UP.
*           FILEDDC = DD. 
*           RPOS DD MODIFIER SENT, IF NECESSARY.
* 
*     PROCESS 
* 
*     THE PROBLEM IS TO DETERMINE THE RPOS-DD MODIFIER, FIP-DD, 
*     AND PARAMETERS TO ROUTE THE FILE. 
* 
*     FIRST, A FEW NOTES AND CAUTIONS.... 
* 
*     1.) IF QTFI TRIES TO SEND THE FILE IN CHARACTER MODE, 
*         WHILE WE INFORM OUR FIP THAT THE FILE IS BINARY,
*         OR VICE-VERSA, SPURIOUS NAD HARDWARE ERRORS WILL
*         BE REPORTED. THEREFORE, A SPECIAL EFFORT WILL BE
*         MADE TO INFORM QTF (WITH AN RPOS DD MODIFER) IF 
*         WE DECIDE THE FILE SHOULD BE SENT IN AN OPPOSITE
*         MODE FROM THAT REQUESTED ON THE RFT. ALSO, WE 
*         MUST TELL OUR FIP THE CORRECT MODE. 
* 
*     2.) IN AID OF THE ABOVE, THE ALGOLRITHM BELOW TRIES 
*         TO DETERMINE THE PROPER "INTERNAL CHARACTERISTICS"
*         (THE DSP "IC" PARAMETER WITH WHICH TO ROUTE THE 
*         FILE. BASICALLY, FILES WITH AN IC OF BIN ARE SENT 
*         AS BINARY, IC OF TRANS (NOSBE ONLY) ARE BINARY, 
*         AND FILES WITH IC OF ASCII OR DISPLAY ARE SENT
*         AS CHARACTER. THE RPOS-DD WILL BE MODIFIED, IF
*         NECESSARY, AND OUR FIP WILL BE INFORMED.
* 
*     3.) IN PROCESSING ROUTING TEXTS, EXPLICIT OVERRIDES 
*         SYSTEM OVERRIDES IMPLICIT. IN ADDITION, IF
*         A DC PARAMETER IN SPECFIED ON THE TEXT, ANY 
*         PREVIOUS IC AND EC PARAMETERS ARE CLEARED.
* 
*     4.) THERE IS NO DISTINCTION BETWEEN US AND UU CHARACTER TYPES 
*         UNDER EITHER NS2 OR NOSBE. THEREFORE, WE MAKE NO DISTINCTION
*         HERE. 
* 
*     5.) UNDER NOS-1, C8 DOESN/T MEAN THE SAME THING AS
*         UNDER NS2/NBE. THEREFORE, FOR TRUE C8 FILES 
*         (I.E., UPPER/LOWER CASE ASCII PRINT FILES)
*         WE MUST SET FIP-DD TO C8 TO CAUSE FIP 
*         TO TRANSFER THE FILE IN CHARACTER MODE, RATHER
*         THAN THE USUAL BINARY TRANSFER. 
* 
*     ALGORITHM 
* 
*     STEP 1.) RFT-DD PROCESSING - SET UP DEFAULT 
*     VALUES FOR FILEDCC, FILEECS AND FILEICS 
*     (THE EVENTUAL DSP DISPOSITION CODE, EC AND IC)
*     BASED ON THE DC VALUE SENT ON THE RFT.
* 
*     CASE RFT-DC OF: 
* 
*     LP: DSP-DC = PR 
*         DSP-EC = DEFAULT
*         DSP-IC = DIS
* 
*     CP: DSP-DC = PU 
*         DSP-EC = DEFAULT (O26 OR O29) 
*         DSP-IC = DIS
* 
*     P8: DSP-DC = PU 
*         DSP-EC = 80COL
*         DSP-IC = BIN
* 
*     PB: DSP-DC = PU 
*         DSP-EC = SB 
*         DSP-IC = BIN
* 
*     IN,IX: DSP-DC = PU
*         DSP-IC = DIS
* 
*     SP: DSP-DC = PT FOR NBE, PL FOR NOS.
*         DSP-IC = BIN
* 
*     STEP 2.) SPECIAL CASE ASCII PRINT FILES.
* 
*     IF RFT-DD = C8 AND RFT-DC = PR
*     AND REMOTE MAINFRAME IS NBE/NS2/NOS (I.E. A MACHINE WHOSE 
*                                          NORMAL CHARACTER SIZE
*                                          IS SIX BITS) 
*     THEN
*       DSP-EC = A9 
*       DSP-IC = ASCII
* 
*     STEP 3.) PROCESS TEXT PARAMETERS, OVERRIDING ANY DEFAULTS 
*              SET UP SO FAR. 
* 
*       A.) PROCESS IMPLICIT TEXT ( IF ANY) 
*       NOS ONLY--- 
*          DSP-FM = IMPLICIT TEXT FAMILY NAME 
*          DSP-ID = IMPLICIT TEXT ID
*          DSP-CREATION UN = IMPLICIT TEXT CREATION UN
*          DSP-CREATION FM = IMPLICIT TEXT CREATION FM
* 
*       NOSBE ONLY--- 
*          DSP-TID = IMPLICIT TEXT TID
* 
*       B.) PROCESS SYSTEM TEXT 
*           IF SYSTEM TEXT DC SPECIFIED 
*           THEN
*             SET DSP EC AND IC TO DEFAULTS 
*           PROCESS REMAINING ROUTING TXT PARAMETERS. 
* 
*       C.) PROCESS EXPLICIT TEXT 
*           IF EXPLICIT TEXT DC SPECIFIED,
*           THEN
*             SET DSP EC AND IC TO DEFAULTS.
*           PROCESS REMAINING ROUTING TEXT PARAMETERS.
* 
*     STEP 4.) CALCULATE RPOS-DD (IF ANY) AND FIP DD
* 
*     CASE REMOTE MAINFRAME TYPE OF 
* 
*     NS2/NBE: (WHICHEVER ONE WE ARE) 
*       FIP-DD = RPOS-DD = DD$UH
* 
*     NS2/NBE: (WHICHEVER ONE WE ARE NOT) 
*       FIP-DD = US (WE KNOW THAT THE OTHER MAINFRAME 
*                    ALSO HAS 60-BIT WORDS, THUS WE CAN 
*                    GET AWAY WITH THIS)
*       IF RFT-DD WAS NOT US OR UU (DON/T LET INITIATOR 
*          THEN RPOS-DD = US        SEND AS CHARACTER DATA
*                                   IF WE EXPECT BINARY. SEE ABOVE) 
* 
*     NOS 
*       FIP-DD = US FOR NBE, UH FOR NOS.
*       IF RFT-DD = C8: 
*         IF DSP-IC = ASCII:  
*           FIP-DD = C8 
*         ELSE: 
*           FIP-DD = C6 
*       ELSE: 
*         IF RFT-DD NOT FIP-DD: 
*           RPOS-DD = FIP-DD  (US OR UH)
* 
*     OTHER 
*       FIP-DD = US 
*       IF RFT-DD = C6 C8 OR NONE 
*       THEN CASE DSP-IC OF 
* 
*         DIS: FIP-DD = C6
* 
*         ASCII: FIP-DD = C8
* 
*         BIN: RPOS-DD = US 
* 
*         TRANS (NBE ONLY) RPOS-DD = US (REMEMBER THAT IC=TRANS 
*                                        MEANS, ESSENTIALLY, 8-BIT
*                                        EBCDIC, PACKED 8 BITS IN 
*                                        12. IN OTHER WORDS, THE
*                                        FILE IS PROBABLY GOING TO
*                                        GET GARBLED UNLESS THE 
*                                        OTHER MAINFRAME HAS THE
*                                        SAME WORD LENGTH AS WE DO, 
*                                        AND HAS FORMATTED ITS DATA 
*                                        THUSLY. STILL, WE CAN HOPE 
*                                        FOR THE BEST.) 
* 
*     STEP 5.) SPECIAL CASE INPUT FILES. IF THIS IS 
*              AN INPUT FILE AND RFT-DC OR SYSTEM TEXT-DC 
*              WAS IX, SET FILES SOURCE LID TO DESTINATION LID. 
# 
  
      ITEM ERTERR B;
      ITEM IRTERR B;
      ITEM SRTERR B;
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC DUDD;                 # DECIDE UPON DD # 
        PROC NAME;                 # DEBUG CODE # 
        PROC PRDC;                 # PROCESS RFT DEVICE CODE #
        PROC TXTGET;               # GET FWA AND LENGTH OF TEXT # 
        FUNC VALTEXT    B;         # PROCESS ROUTING TEXT # 
        END 
  
# 
****  XREF END
# 
  
      ITEM TXTADR     U;           # POINTER TO TEXT #
      ITEM TXTLEN     U;           # TEXT LENGTH IN CHARACTERS #
      BASED ARRAY TXT;
        BEGIN 
        ITEM TXT$IRTRMH C(00,00,03);  # IMPLICIT TEXT HOST TYPE # 
        ITEM TXT$SRTCYB C(00,00,03);  # SYSTEM TEXT TYPE #
        ITEM TXT$IRTPID C(00,18,07);  # IMPLICIT TEXT PID # 
        END 
  
        $BEGIN
        NAME("PCM00");
        $END
  
# 
*     STEP 1 - SET UP DEFAULTS ACCORDING TO RFT-DC
# 
  
    CONTROL IFEQ OS$NOSBE;
      FILEPRI = O"2000";           # DEFAULT OUTPUT QUEUE PRIORITY #
    CONTROL ENDIF;
  
      PRDC; 
# 
*     STEP 2 - SPECIAL CASE ASCII PRINT FILES 
# 
      IF     (FILEOTY EQ OD$PR) 
         AND (FILEDDC EQ DD$C8) 
         AND (    (FILERMH EQ NS2)
               OR (FILERMH EQ NOS)
               OR (FILERMH EQ NBE)  ) 
      THEN
        BEGIN 
        FILEECS = 6;               # EC= A9 # 
        FILEICS = 1;               # IC= ASCII# 
        END;
  
# 
*     STEP 3 - PROCESS TEXT PARAMETERS
# 
      IRTERR = FALSE; 
      ERTERR = FALSE; 
      SRTERR = FALSE; 
  
# 
*     STEP A - IMPLICIT 
# 
      IF FILEIRT NE 0 
      THEN
        BEGIN 
        TXTGET(FILEIRT, TXTADR, TXTLEN);
        P<TXT> = TXTADR;
        IF (TXTLEN GT 10) 
          AND (TXT$IRTRMH EQ HTSAME)
          AND (TXT$IRTPID EQ HID) 
        THEN
          BEGIN 
          TXTLEN = TXTLEN - 10; 
          TXTADR = TXTADR + 1;     # POINT TO *ROUTE,...* # 
          IRTERR = VALTEXT(TXTADR, TXTLEN, "I");
          IF NOT IRTERR 
          THEN
            BEGIN 
            FILEIRT = 0;           # FINISHED WITH THIS TEXT #
            END 
  
          END 
  
        END 
  
# 
*     STEP B - SYSTEM 
# 
      IF NOT IRTERR 
      THEN
        BEGIN 
        IF FILESRT NE 0 
        THEN
          BEGIN 
          TXTGET(FILESRT, TXTADR, TXTLEN);
          P<TXT> = TXTADR;
          IF (TXTLEN GT 3)
            AND (TXT$SRTCYB EQ "CYB") 
          THEN
            BEGIN 
            SRTERR = VALTEXT(TXTADR, TXTLEN, "S");
            IF NOT SRTERR 
            THEN
              BEGIN 
              FILESRT = 0;         # FINISHED WITH THIS TEXT #
              END 
  
            END 
  
          END 
  
# 
*     STEP C - EXPLICIT 
# 
        IF NOT SRTERR 
        THEN
          BEGIN 
          IF (FILEERT NE 0)        # IF EXPLICT TEXT EXISTS # 
            AND (NOT FILELIDSH)    #   AND NOT STORE-FORWARD TRANSFER # 
          THEN
            BEGIN 
            TXTGET(FILEERT, TXTADR, TXTLEN);
            P<TXT> = TXTADR;
            IF (TXTLEN GT 0)
            THEN
              BEGIN 
              ERTERR = VALTEXT(TXTADR, TXTLEN, "E");
              IF NOT ERTERR 
              THEN
                BEGIN 
                FILEERT = 0;       # FINISHED WITH THIS TEXT #
                END 
  
              END 
  
            END 
  
  
          IF NOT ERTERR 
          THEN
            BEGIN 
# 
*                 STEP 4 - SPECIAL CASE INPUT FILES.
# 
            FILEINT = FILEOTY EQ OD$IN; 
            IF FILEOTY EQ OD$IX    # IF DC = IX # 
            THEN
              BEGIN 
              FILEINT = TRUE; 
              FILESLD = FILELID;   # OUTPUT STAYS AT DESTINATION #
              END;
  
# 
*                 STEP 5 - CALCULATE FIP-DD AND, IF NEEDED, RPOS-DD.
# 
            DUDD; 
  
            END;
  
          END;
  
        END;
  
      END  # PCM00 #
TERM
