0  BEGIN PGM 90351_en MM 
1  ;NC program for extracting the file name from
2  ;the complete path. First, the text file is
3  ;copied into an NC program. In this program,
4  ;the file path is assignet to the string
5  ;parameter QS1. The porgram seperates the file
6  ;name from this string. The string is searched
7  ;for the "\" and the part of the string
8  ;before it is removed. This step is repeated
9  ;until no more "\" characters are  found. Then
10 ;the control removes the file name extension
11 ;".h" so that only the file name remains. The
12 ;control transfers it in QS1 to the original
13 ;program.
14 ;At program end the control deletes the text
15 ;file "FILE.a" and the NC program "FILE.h"
16 ;
17 ;Copy a text file into an NC program
18 FUNCTION FILECOPY "FILE.a" TO "FILE.H"
19 ;
20 ;Select file from path, whereby the character
21 ;to find is "\"
22 QS2 = "\"
23 ;
24 ;Call the program "FILE.h" in order to read
25 ;out the QS1 with the path saved in it
26 CALL PGM FILE.H
27 ;
28 LBL 1 ;Begin of loop
29 ;
30 ;Search string QS1 for "\"
31 Q50 = INSTR( SRC_QS1 SEA_QS2 BEG0 )
32 ;The result in Q50 is the place at which the
33 ;"\" was found
34 ;
35 ;Increase the result of Q50 by 1
36 Q52 = Q50 + 1
37 ;
38 ;Read out the entire length of the string, save
39 ;it as Q53
40 Q53 = STRLEN( SRC_QS1 )
41 ;
42 ;Entire length of the string -1
43 Q55 = Q53 - 1
44 ;If the INSTR command does not fine the "\"
45 ;character, it return the length of the string
46 ;beginning with place 1. If the "\" character
47 ;is no longer contained in QS1, the control 
48 ;jumps to the "END" label
49 FN 9: IF +Q50 EQU +Q53 GOTO LBL "END"
50 ;
51 ;Length of the string - all characters up
52 ;to "\"
53 Q54 = Q53 - Q52
54 QS1 = SUBSTR( SRC_QS1 BEGQ52 LENQ54 )
55 ;
56 ;Jump to LBL1
57 FN 9: IF +0 EQU +0 GOTO LBL 1
58 ;
59 ;Remove the file extension
60 ;File name extracted with extension
61 LBL "END"
62 ;
63 ;Remove file name extension, e.g. ".H"
64 ;Q56 = total length of string
65 ;(file name + extension)-2
66 Q56 = Q53 - 2
67 ;Read out file name
68 QS1 = SUBSTR( SRC_QS1 BEG0 LENQ56 )
69 ;
70 ;Delete help files
71 FUNCTION FILEDELETE "FILE.a"
72 FUNCTION FILEDELETE "FILE.h"
73 ;
74 ;Program end; the file name in QS1 is
75 ;transferred to the calling program
76 END PGM 90351_en MM