0 BEGIN PGM 90351_es MM 
1 ;Programa NC para extraer el nombre del
2 ;fichero de la ruta completa. Para ello
3 ;se copia primeramente el fichero de
4 ;texto en un programa NC. En dicho programa
5 ;se le asigna al parámetro de cadena QS1 la
6 ;ruta del fichero.
7 ;De dicha cadena, el programa separa en
8 ;nombre del fichero. Para ello, se retira la
9 ;cadena tras la parte vertical de la cadena.
10 ;Este paso se repite hasta que no se
11 ;encuentra ninguna "\". A continuación, el
12 ;control numérico retira la extensión de
13 ;fichero ".h", de tal modo que sólo quede el
14 ;nombre del fichero.
15 ;Este lo entrega el control numérico entonces
16 ;en el QS1 al programa original.
17 ;Al final del programa, el control numérico
18 ;borra el fichero de texto "FILE.a" y el
19 ;programa NC "FILE.H".
20 ;
21 ;Copiar el fichero de texto en un programa NC
22 FUNCTION FILECOPY "FILE.a" TO "FILE.H"
23 ;
24 ;Seleccionar de la ruta el nombre del fichero.
25 ;carácter a buscar
QS2 = "\"
26 ;
27 ;Llamar programa "FILE.H" para leer el QS1 con
28 ;la ruta depositada en el mismo
29 CALL PGM FILE.H
30 ;
31 LBL 1 ;Comienzo del bucle
32 ;
33 ;Buscar "\" en la cadena QS1
Q50 = INSTR( SRC_QS1 SEA_QS2 BEG0 )
34 ;El resultado en Q50 es la posición en la que
35 ;se encontró la "\"
36 ;
37 ;Aumentar en 1 el resultado del Q50
Q52 = Q50 + 1
38 ;
39 ;Leer la longitud total de la cadena, guardar
40 ;en Q53
Q53 = STRLEN( SRC_QS1 )
41 ;
42 ;Longitud total cadena -1
Q55 = Q53 - 1
43 ;Si la instrucción INSTR no encuentra el
44 ;carácter "\", devuelve la longitud de la
45 ;cadena, empezada en la posición 1. Si el
46 ;carácter "\" ya no está en el QS1, el
47 ;control numérico salta a LBL "END"
48 FN 9: IF +Q50 EQU +Q53 GOTO LBL "END"
49 ;
50 ;Longitud cadena - todos los caracteres
51 ;hasta "\"
Q54 = Q53 - Q52
QS1 = SUBSTR( SRC_QS1 BEGQ52 LENQ54 )
52 ;
53 ;Salto a LBL 1
54 FN 9: IF +0 EQU +0 GOTO LBL 1
55 ;
56 ;Retirar la extensión del fichero
57 ;Nombre del fichero con extensión extraída
58 LBL "END"
59 ;
60 ;Retirar la extensión del fichero, p. ej. .H
61 ;Q56 = Longitud total cadena
62 ;(Nombre del fichero+extensión)-2
Q56 = Q53 - 2
63 ;Leer nombre del fichero
QS1 = SUBSTR( SRC_QS1 BEG0 LENQ56 )
64 ;
65 ;Borrar ficheros de ayuda
66 FUNCTION FILEDELETE "FILE.a"
67 FUNCTION FILEDELETE "FILE.h"
68 ;
69 ;Final del programa, el nombre del fichero se
70 ;entrega en el QS1 también al programa a
71 ;llamar.
72 END PGM 90351_es MM