source: IHS-VA_UTILITIES-XB/trunk/XBPFTV.m@ 1772

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

Modified directory structure; moved routines.

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.