MACRO 00001000
DMSPID &FILEID 00002000
.* THIS MACRO PARSES A FILEID ENCLOSED IN QUOTE MARKS ('FN FT FM') 00003000
.* INTO A SEPARATE FILENAME, FILETYPE, AND FILEMODE. 00004000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00005000
LCLA &BGN,&CNT,&PNT 00006000
AIF (T'&FILEID EQ 'O').EXIT 00007000
AIF ('&FILEID'(1,1) EQ '(').EXIT 00008000
AIF (K'&FILEID LE 2).ERR1 00009000
AIF ('&FILEID'(1,1) NE '''').ERR1 00010000
AIF ('&FILEID'(K'&FILEID,1) NE '''').ERR1 00011000
&PNT SETA 1 00012000
.LOOP1 ANOP 00013000
&PNT SETA &PNT+1 00014000
AIF (&PNT GE K'&FILEID).EXIT 00015000
AIF ('&FILEID'(&PNT,1) EQ ' ').LOOP1 00016000
&BGN SETA &PNT 00017000
.LOOP2 ANOP 00018000
&PNT SETA &PNT+1 00019000
AIF (&PNT GE K'&FILEID).CONT1 00020000
AIF ('&FILEID'(&PNT,1) NE ' ').LOOP2 00021000
.CONT1 ANOP 00022000
&CNT SETA &PNT-&BGN 00023000
AIF (&CNT LE 8).CONT2 00024000
MNOTE 4,'FILENAME TRUNCATED TO 8 CHARACTERS' 00025000
&CNT SETA 8 00026000
.CONT2 ANOP 00027000
&DMSNAME SETC '&FILEID'(&BGN,&CNT) 00028000
.LOOP3 ANOP 00029000
&PNT SETA &PNT+1 00030000
AIF (&PNT GE K'&FILEID).EXIT 00031000
AIF ('&FILEID'(&PNT,1) EQ ' ').LOOP3 00032000
&BGN SETA &PNT 00033000
.LOOP4 ANOP 00034000
&PNT SETA &PNT+1 00035000
AIF (&PNT GE K'&FILEID).CONT3 00036000
AIF ('&FILEID'(&PNT,1) NE ' ').LOOP4 00037000
.CONT3 ANOP 00038000
&CNT SETA &PNT-&BGN 00039000
AIF (&CNT LE 8).CONT4 00040000
MNOTE 4,'FILETYPE TRUNCATED TO 8 CHARACTERS' 00041000
&CNT SETA 8 00042000
.CONT4 ANOP 00043000
&DMSTYPE SETC '&FILEID'(&BGN,&CNT) 00044000
.LOOP5 ANOP 00045000
&PNT SETA &PNT+1 00046000
AIF (&PNT GE K'&FILEID).EXIT 00047000
AIF ('&FILEID'(&PNT,1) EQ ' ').LOOP5 00048000
&BGN SETA &PNT 00049000
.LOOP6 ANOP 00050000
&PNT SETA &PNT+1 00051000
AIF (&PNT GE K'&FILEID).CONT5 00052000
AIF ('&FILEID'(&PNT,1) NE ' ').LOOP6 00053000
.CONT5 ANOP 00054000
&CNT SETA &PNT-&BGN 00055000
AIF (&CNT LE 2).CONT6 00056000
MNOTE 4,'FILEMODE TRUNCATED TO 2 CHARACTERS' 00057000
&CNT SETA 2 00058000
.CONT6 ANOP 00059000
&DMSMODE SETC '&FILEID'(&BGN,&CNT) 00060000
.EXIT MEXIT 00061000
.ERR1 MNOTE 8,'INVALID FILEID SPECIFICATION' 00062000
MEND 00063000