*DECK C$LABLS 
          IDENT  C$LABLS
          TITLE  CBLABLS - STANDARD LABELS PROCESSOR
          MACHINE   ANY,I 
          COMMENT   STANDARD LABELS PROCESSOR 
  
          SST 
          B1=1
*CALL IOMICROS
  
 C.LABLS  SPACE  4
**        C.LABLS - PROCESSES STANDARD HDR1 LABELS
* 
*                BUILDS A STANDARD FORMAT -HDR1- LABEL FROM USER SUPPLIED 
*                            INFORMATION AND GIVES IT TO CRM. 
* 
*         CALLED: 
* 
*         SA0    FIT
*         RJ     =XC.LABLI
* 
*                EXPECTS B1 = 1 AND A LABEL INFO TABLE TO BE
*                            POINTED TO AT -LVOT- IN THE FIT. 
* 
*                            EACH ENTRY IN THE -LVOT- TABLE POINTS
*                            TO A LABEL FIELD.  C.LABLS PLACES THIS IN
*                            THE PROPER PLACE IN THE LABEL, SETS THE
*                            CRM LABEL ROUTINE TO C.LX AND RETURNS. 
* 
*                            CRM CALLS C.LX WHO READS/WRITES THE LABEL
*                            AND RETURNS TO CRM.
* 
*         ENTRY POINTS: 
          ENTRY  C.LABLI
          ENTRY  C.LX 
* 
*         EXTERNALS:  
          EXT    C.MOVE 
          EXT    C.ZERO 
* 
*         REGISTERS USED: 
*                ALL BUT A0 + B1
* 
* 
 C.LABLS  SPACE  4
 C.LABLI  DATA   0
          SB1    1
          STORE  A0,LA=LABL 
          STORE  A0,LBL=80
          STORE  A0,LX=C.LX 
          STORE  A0,ULP=F 
          FETCH  A0,LVOT,X1 
          SX7    0
          SA2    =4LHDR1
          BX6    X2 
          SA6    LABL        INIT LABEL AREA
          SA7    A6+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          ZR     X1,C.LABLI  EXIT IF JO VALUES
 LABLS2   SX6    X1+B1       GET NEXT ENTRY IN TABLE
          SA2    X1 
          SA6    POINTER
          ZR     X2,C.LABLI  DONE 
          SB5    X2 
          LX2    4
          SX3    X2          LTFL + JUNK
          SX6    77B         MASK 
          LX2    38 
          BX5    X6*X2       LTIL LENGTH
          SB7    X5 
          AX2    6
          AX6    2           MASK = 17B 
          BX5    X6*X2
          BX3    X3*X6
          SB3    X3+0        LTFL 
          SB6    X5+0        SBCP 
          LX2    59-4        LTAN BIT 
          JP     B3+LABLS4
 LABLS4   EQ     ERROR
+         EQ     FLID        1     FILE-ID
+         EQ     FLSTI       2     FILE-SET-ID
+         EQ     FLSCN       3     FILE-SECTION-NR
+         EQ     FLSQN       4     FILE-SEQ-NR
+         EQ     GENER       5     GEN-NR 
+         EQ     GENUVN      6     GEN-VER-NR 
+         EQ     CRDT        7     CREATION-DATE
+         EQ     EXPDT       8     EXPIRATION-DATE
+         EQ     ACCESS      9     ACCESSIBILITY
  
 FLID     EJECT 
*                FLID - FILE-ID FIELD 
* 
 FLID     BSS    0
          SX3    17          SIZE OF FIELD
          SB3    LABL        FWA
          SB4    4           BCP
          SX2    B7 
          IX2    X2-X3
  
 SETMVE   NG     X2,MVE1
          SB7    X3          TRUNCATE SOURCE
          SX2    B0          NO BLANK FILL
 MVE1     RJ     =XC.MOVE 
          SA1    POINTER
          EQ     LABLS2      BACK TO LOOP 
  
 FLSTI    SPACE  4
*                FLSTI -FILE-SET-ID 
* 
 FLSTI    BSS    0
          SX3    6           SIZE OF FIELD
          SB3    LABL+2      FWA
          SB4    1           BCP
          SX2    B7 
          IX2    X2-X3
          EQ     SETMVE 
 FLSCN    EJECT 
*                FLSCN - FILE-SECTION-NR
* 
 FLSCN    BSS    0
          NG     X2,LABERR   NOT NUMERIC SOURCE 
          SB2    4           FLD SIZE 
          SB3    LABL+2      FWA
          SB4    7           BCP
          SX2    B0          NO BLANK FILL
          GE     B7,B2,LONG 
          RJ     SHORT       SHORT FIELD, ZERO FILL 
          SB3    LABL+2 
          SA3    SVB2 
          SB7    X3 
          SX2    B0 
          SB4    7
  
 FILL     SB5    =XC.ZERO 
          SB6    0
          RJ     =XC.MOVE 
          SA1    POINTER
          EQ     LABLS2      GO LOOP
  
 LONG     SPACE  4
* 
*         LONG - SOURCE SIZE GE DEST SIZE - TRUNCATE, NO FILL 
* 
 LONG     BSS    0
          EQ     B7,B2,LONG2       EQ SIZE
          SX3    B2+0        SAVE 
          SB2    B7-B2
          SB6    B6+B2       NEW SBCP 
          SB7    X3+0        NR CHARS TO MOVE 
  
 LONG2    RJ     =XC.MOVE 
          SA1    POINTER
          EQ     LABLS2 
  
 SHORT    SPACE  4
* 
*         SHORT - DO SHORT NUMERIC MOVE + SAVE NR OF FILL CHARS 
* 
 SHORT    DATA   0
          SB2    B2-B7       NR ZEROS 
          SX6    B2 
          SA6    SVB2 
          SB4    B4+B2       NEW DBCP 
          RJ     =XC.MOVE 
          EQ     SHORT
 FLSQN    EJECT 
*                FLSQN - FILE-SEQUENCE-NR 
* 
 FLSQN    BSS    0
          NG     X2,LABERR
          SB2    4           SIZE 
          SB3    LABL+3      FWA
          SB4    B1          BCP
          SX2    B0 
          GE     B7,B2,LONG 
          RJ     SHORT
          SB3    LABL+3      DO BLANK FILL
          SA3    SVB2        NR ZEROS 
          SB4    B1 
          SB7    X3 
          SX2    0
          EQ     FILL 
  
 GENER    SPACE  4
*                GENER - GENERATION-NR
* 
 GENER    BSS    0
          NG     X2,LABERR
          SB2    4
          SB3    LABL+3 
          SB4    5
          SX2    B0 
          GE     B7,B2,LONG 
          RJ     SHORT
          SB3    LABL+3 
          SA3    SVB2 
          SB4    5
          SB7    X3 
          SX2    B0 
          EQ     FILL 
  
 GENUVN   SPACE  4
*                GENUVN - GENERATION-VERSION-NR 
* 
 GENUVN   BSS    0
          NG     X2,LABERR
          SB2    2
          SB3    LABL+3 
          SB4    9
          SX2    B0 
          GE     B7,B2,LONG 
          RJ     SHORT
          SB3    LABL+3 
          SA3    SVB2 
          SB4    9
          SB7    X3 
          SX2    B0 
          EQ     FILL 
  
 CRDT     SPACE  4
*                CRDT  - CREATION-DATE
* 
 CRDT     BSS    0
          SB4    1
          RJ     LABDT       CHECK/MOVE CREATION DATE 
          SB4    6           CREATION DATE SHIFT COUNT
 CRDT2    SA1    LABL+4 
          MX2    54 
          LX1    B4          GET DECADE DIGIT INTO UPPER CHARACTER
          BX1    X2*X1       CLEAR SPACE FOR *ISO* CENTURY FLAG 
          SX3    1R          PRESET FOR 20TH CENTURY
          NG     X1,CRDT3    IF DECADE DIGIT IS 5 OR GREATER
          SX3    1R0         SET FOR 21ST CENTURY 
 CRDT3    BX6    X1+X3       MERGE IN *ISO* CENTURY FLAG
          SB3    60 
          SB4    B3-B4
          LX6    B4 
          SA6    A1 
          SA1    POINTER
          EQ     LABLS2      LOOP FOR NEXT ENTRY
  
 EXPDT    SPACE  4
*                EXPDT  - EXPIRATION-DATE 
* 
 EXPDT    BSS    0
          SB4    7
          RJ     LABDT       CHECK/MOVE EXPIRATION DATE 
          SB4    42          EXPIRATION DATE SHIFT COUNT
          EQ     CRDT2
  
 LABDT    SPACE  4
*                LABDT  - LABEL DATE FIELD
* 
 LABDT    DATA   0
          NG     X2,LABERR
          SB3    LABL+4 
          SB2    B7-5 
          SX2    1
          NZ     B2,LABERR   BAD FIELD
          RJ     =XC.MOVE 
          EQ     LABDT       RETURN 
  
 ACCESS   SPACE  4
*                ACCESS  - ACCESSIBILITY
* 
 ACCESS   BSS    0
          SX3    1
          SB3    LABL+5 
          SB4    3           BCP
          SX2    B7 
          IX2    X2-X3
          EQ     SETMVE 
  
  
 LABERR   EQ     *+400000B         **TEMP***
 ERROR    EQ     *+400000B
 C.LX     EJECT 
**        C.LX  - CRM LABEL READ/WRITE ROUTINE
* 
*         CHANGE THE MULTI-FILE POSITION NUMBER TO 9999 IF THIS IS A
*         OUTPUT FILE.
*         DOES A PUTL ON THE LABEL FIELD, CLEARS THE LABEL
*                AREAS IN THE FIT AND RETURNS.
* 
 C.LX     BSS    0
          FETCH  A0,MFN,X2
          ZR     X2,NOTMF    SKIP IF NOT MULTI-FILE 
          FETCH  A0,PD,X2 
          SX2    X2-#OUTPUT#
          NZ     X2,NOTMF    POSITION TO END-OF-SET IF OUTPUT MULTI-FILE
          SX2    B0          NO FILL
          SB3    LABL+3      FWA
          SB4    B1          DEST BCP 
          SB5    =4H9999     END-OF-SET POINTER 
          SB6    B0          SBCP 
          SB7    4           LTIL 
          RJ     =XC.MOVE 
 NOTMF    BSS    0
          PUTL   A0,LABL,80 
          STORE  A0,LA=0
          STORE  A0,LBL=0 
          STORE  A0,LX=0
          STORE  A0,ULP=NO
          CLOSEL A0          RETURN 
 MISC     EJECT 
* 
*         WORKING-STORAGE SECTION 
* 
  
 SVB2     BSS    1
 POINTER  BSS    1
 LABL     BSS    8
  
          END 
