source: IHS-VA_UTILITIES-XB/XBPFTV.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.3 KB
RevLine 
[641]1XBPFTV(F,E,V) ; IHS/ADC/GTH - RETURN POINTER FIELD TERMINAL VALUE ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; NOTE TO PROGRAMMERS; Use entry point PFTV. Do not use
5 ; the first line of this routine, as pending initiatives
6 ; in MDC might make a formal list on the first line of a
7 ; routine invalid. GTH 07-10-95
8 ;
9 ; Given a file number, file entry number, and variable
10 ; name into which the results will be placed, return the
11 ; terminal value after following the pointer chain.
12 ;
13 ; U must exist and have a value of "^"
14 ;
15 ; Formal list:
16 ;
17 ; 1) F = file number (call by value)
18 ; 2) E = file entry number (call by value)
19 ; 3) V = variable for results (call by reference)
20 ;
21 ; Scratch vars:
22 ; D = Flag, 1 = Done, 0 = continue
23 ; G = Global for file F.
24 ;
25 ; *** NO ERROR CHECKING DONE ***
26 ;
27 G START
28 ;
29 ; The below PEP should be used in case the current movement to
30 ; not allow a formal list of parameters on the first line of a
31 ; routine passes thru MDC.
32 ;
33PFTV(F,E,V) ;PEP - Return Pointer Field Terminal Value.
34 ;
35START ;
36 NEW D,G
37 F D TRACE Q:D
38 Q
39 ;
40TRACE ; FOLLOW POINTER CHAIN
41 S D=1,V=E
42 Q:'E
43 S G=^DIC(F,0,"GL")
44 Q:'$D(@(G_E_",0)"))
45 S V=$P(@(G_E_",0)"),U)
46 Q:$P(^DD(F,.01,0),U,2)'["P"
47 S F=+$P($P(^DD(F,.01,0),U,2),"P",2)
48 Q:'$D(@(G_E_",0)"))
49 S E=$P(@(G_E_",0)"),U)
50 S D=0
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.