CTITLESAPK03 - SUBROUTINE USED BY SDPICK                                00010000
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA                                                                      00020000
CA   DESIGNER             P. C. LUH                                     00030000
CA   AUTHOR               P. C. LUH                                     00040000
CA   LANGUAGE             FORTRAN                                       00050000
CA   SYSTEM               IBM  ONLY                                     00060000
CA   DATE                 MM/DD/YY                                      00070000
C    REVISED              03/06/86  LBL  OLD NAME = DSFIND.             00080000
C                                                                       00090000
C                                                                       00100000
C     SUBROUTINE DSFIND(FIELD,DSNAME,IERR,IPR)                          00110000
      SUBROUTINE SAPK03(FIELD,DSNAME,IERR,IPR)                          00120000
C     PROGRAM FIND                                                      00130000
C                                                                       00140000
C  THIS PROGRAM READS A SET OF DSN NUMBERS FROM 'SYSIN' AND FINDS       00150000
C  THEIR CORRESPONDING FULLY QUALIFIED DSN NAMES, PRINTING THEM ON      00160000
C  'SYSOUT'.                                                            00170000
C                                                                       00180000
      IMPLICIT INTEGER(A-Z)                                             00190000
      CHARACTER*8 DSNUM,FIELD                                           00200000
      CHARACTER*44 DSNAME                                               00210000
      CHARACTER*4 DIST                                                  00220000
      CHARACTER*1 ICHAR                                                 00230000
C                                                                       00240000
      IERR=0                                                            00250000
      IF(FIELD.NE.' '.AND.FIELD.NE.'  0    0') GO TO 200                00260000
C                                                                       00270000
  100 CONTINUE                                                          00280000
      IERR=1                                                            00290000
      RETURN                                                            00300000
C                                                                       00310000
  200 CONTINUE                                                          00320000
C     DIST = '  99'                                                     00330000
      DIST = '  01'                                                     00340000
C                                                                       00350000
C  SCAN THE INPUT FIELD FOR NON-NUMERIC ITEMS, AND PROPERLY             00360000
C  JUSTIFY IT.                                                          00370000
C                                                                       00380000
      ISHIFT = 0                                                        00390000
      DO 150 I=1,8                                                      00400000
            ICHAR = FIELD(I:I)                                          00410000
            IF(ICHAR .EQ. ' ') THEN                                     00420000
                  ISHIFT = ISHIFT + 1                                   00430000
                  ICHAR = '0'                                           00440000
            ELSE                                                        00450000
                  ISHIFT = 0                                            00460000
                  ENDIF                                                 00470000
            IF(ICHAR .LT. '0' .OR. ICHAR .GT. '9') THEN                 00480000
                  WRITE (IPR,350) FIELD                                 00490000
 350              FORMAT(' ILLEGAL DSN NUMBER:  ',A8)                   00500000
                  GO TO 100                                             00510000
                  ENDIF                                                 00520000
            FIELD(I:I) = ICHAR                                          00530000
 150        CONTINUE                                                    00540000
      IF(ISHIFT .LT. 8) DSNUM(ISHIFT+1:8) = FIELD(1:8-ISHIFT)           00550000
      IF(ISHIFT .GT. 0) THEN                                            00560000
            DO 170 I=1,ISHIFT                                           00570000
 170              DSNUM(I:I) = '0'                                      00580000
            ENDIF                                                       00590000
      DSNUM(1:1) = ' '                                                  00600000
      WRITE(IPR, 8100) DIST, DSNUM, DSNAME, ERR1, ERR2                  00610000
 8100 FORMAT(1X, 'UPON CALLING UGCATS: ', A4, A8, A44, 2I5)             00620000
      CALL UGCATS(DIST,DSNUM,DSNAME,ERR1,ERR2)                          00630000
      IF(ERR1 .EQ. 1) GO TO 230                                         00640000
      IF(ERR1 .GT. 1 .AND. ERR1 .LE. 4) THEN                            00650000
            WRITE (IPR,1231) ERR1,ERR2                                  00660000
 1231       FORMAT(' CATALOG SEARCH ERROR (SVC99):',I8,Z12)             00670000
            GO TO 100                                                   00680000
            ENDIF                                                       00690000
      IF(ERR1 .EQ. 5) THEN                                              00700000
            WRITE (IPR,1334) DSNUM                                      00710000
 1334       FORMAT(' DSN NUMBER NOT FOUND:  ',A8)                       00720000
            GO TO 100                                                   00730000
            ENDIF                                                       00740000
      IF(ERR1 .EQ. 6) THEN                                              00750000
            WRITE (IPR,1335) DSNUM                                      00760000
 1335       FORMAT(' MORE THAN ONE NAME FOUND:  ',A8)                   00770000
            GO TO 100                                                   00780000
            ENDIF                                                       00790000
 230  CONTINUE                                                          00800000
C                                                                       00810000
      RETURN                                                            00820000
      END                                                               00830000