0 BEGIN PGM 90401_ES MM 
1 ;Programa NC para extraer el nombre del fichero
2 ;de la ruta completa.
3 ;La ruta la guarda el control numérico en el
4 ;programa a llamar en el QS1 y la entrega a
5 ;dicho programa.
6 ;De dicha cadena, el programa separa en nombre
7 ;del fichero. Para ello se busca en la cadena
8 ;después de "\", y la parte precedente en la
9 ;cadena se retira. Este paso se repite hasta que
10 ;no se encuentra ninguna "\". A continuación, el
11 ;control numérico retira la extensión de 
12 ;fichero ".h", de tal modo que sólo quede el
13 ;nombre del fichero. Este lo entrega el control
14 ;numérico entonces en el QS1 devolviéndolo al
15 ;programa a llamar.
16 ;
17 ;Seleccionar de la ruta el nombre del fichero
18 ;carácter a buscar
QS2 = "\"
19 ;
20 LBL 1 ;Comienzo del bucle
21 ;
22 ;Buscar en la cadena QS1 después del carácter "\"
Q50 = INSTR( SRC_QS1 SEA_QS2 BEG0 )
23 ;El resultado en Q50 es la posición en la que se
24 ;encontró la "\" primero
25 ;
26 ;Aumentar en 1 el resultado del Q50
Q52 = Q50 + 1
27 ;
28 ;Leer la longitud total de la cadena, guardar en Q53
Q53 = STRLEN( SRC_QS1 )
29 ;
30 ;Longitud total cadena -1
Q55 = Q53 - 1
31 ;Si la instrucción INSTR no encuentra el carácter "\",
32 ;devuelve la longitud, empezada en la posición 1.
33 ;Si el carácter "\" ya no está en el QS1, el control
34 ;numérico salta a LBL "END".
35 FN 9: IF +Q50 EQU +Q53 GOTO LBL "END"
36 ;
37 ;Longitud cadena - todos los caracteres hasta "\"
Q54 = Q53 - Q52
QS1 = SUBSTR( SRC_QS1 BEGQ52 LENQ54 )
38 ;
39 ;Salto a LBL 1
40 FN 9: IF +0 EQU +0 GOTO LBL 1
41 ;
42 ;Retirar la extensión del fichero
43 ;Nombre del fichero con extensión extraída
44 LBL "END"
45 ;
46 ;Retirar la extensión del fichero, p. ej. .H
47 ;Q56 = Longitud total cadena
48 ;(Nombre del fichero + Extensión) -2
Q56 = Q53 - 2
49 ;Leer nombre del fichero
QS1 = SUBSTR( SRC_QS1 BEG0 LENQ56 )
50 ;
51 ;En el QS1, el nombre del fichero se entrega al programa a
52 ;llamar
53 END PGM 90401_ES MM