source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICL3.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DICL3 ;SF/TKW-VA FileMan: Lookup: Lister, Part 4 ;1/26/99 08:32
2 ;;22.0;VA FileMan;**3**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5FOLLOW(DIFILE,DIF,DIDEF,DICHNNO,DILVL,DIFRFILE,DIFIELD,DIDXFILE,DIVPTR,DISUB,DISCREEN) ;
6 ;
7 ; follow pointer/vp chains to end, building stack along the way
8 ;
9F1 ; increment stack level, loop increments at top
10 ; if pointing file lacks B index, store that in stack
11 ;
12 S DILVL=DILVL+1
13 I DILVL=1 S DIF(1,DIFILE)=U_DIDXFILE
14 I DILVL>1 D
15 . S DIF(DILVL,DIFILE)=DIFRFILE_U_DIVPTR
16 . I '$D(@DIFILE(DIFILE)@("B")) S DIFILE(DIFILE,"NO B")=""
17 . S DIFILE(DIFILE,"O")=$$OREF^DIQGU(DIFILE(DIFILE))
18 . Q
19F2 ; Find data type of .01 field of pointed-to file, process
20 ; end of pointer chain.
21 N T S T=$P(DIDEF,U,2)
22 I T'["P",T'["V" D Q
23 . S DIFILE("STACKEND",DICHNNO)=DILVL_U_DIFILE
24 . N L,F F L=DILVL:-1:1 D
25 . . S DIFILE("STACK",DICHNNO,L,DIFILE)=DIFRFILE_U_DIVPTR
26 . . Q:L=1
27 . . S DIFILE=+DIF(L,DIFILE)
28 . . S F=DIF(L-1,DIFILE),DIFRFILE=$P(F,U),DIVPTR=$P(F,U,2)
29 . S DICHNNO=DICHNNO+1
30 . Q
31F3 ; Advance file number, Process regular pointers within pointer chain.
32 N DIFRFILE S DIFRFILE=DIFILE
33 I T["P" D Q
34 . S DIFILE=+$P($P(DIDEF,U,2),"P",2)
35 . S DIFILE(DIFILE)=$$CREF^DIQGU(U_$P(DIDEF,U,3))
36 . S DIDEF=$G(^DD(DIFILE,.01,0))
37 . D FOLLOW(.DIFILE,.DIF,DIDEF,.DICHNNO,.DILVL,DIFRFILE,"","",0)
38 . Q
39F4 ; Process variable pointers within the pointer chain.
40 N DIVP,G
41 S:'$G(DIFIELD) DIFIELD=.01
42 F DIVP=0:0 S DIVP=$O(^DD(DIFILE,DIFIELD,"V",DIVP)) Q:'DIVP S G=$G(^(DIVP,0)) D
43 . Q:'G
44 . S DIFILE=+G,G=$G(^DIC(DIFILE,0,"GL")) I G="" S DIFILE=DIFRFILE Q
45 . I DILVL=1,$D(DISCREEN("V",DISUB)),'$D(DINDEX(DISUB,"VP",G)) S DIFILE=DIFRFILE Q
46 . S DIFILE(DIFILE)=$$CREF^DIQGU(G)
47 . S DIDEF=$G(^DD(DIFILE,.01,0))
48 . N DISAVL S DISAVL=DILVL
49 . D FOLLOW(.DIFILE,.DIF,DIDEF,.DICHNNO,.DILVL,DIFRFILE,"","",1)
50 . S DILVL=DISAVL,DIFILE=DIFRFILE
51 Q
52 ;
53BACKTRAK(DIFLAGS,DIFILE,DISTACK,DIEN,DIFIEN,DINDEX0,DINDEX,DIDENT,DISCREEN,DILIST) ;
54 ;
55 ; Back up on pointer stack until we get back to home file.
56 ;
57B1 ; back up one level on stack, recover file #, root, and index file,
58 ; and set value to match equal to the previous level's ien value
59 ;
60 N F,DIVPTR S F=DIFILE("STACK",+DISTACK,+$P(DISTACK,U,2),+$P(DISTACK,U,3))
61 S DIVPTR=$P(F,U,2),F=+F
62 N DIVALUE D
63 . I 'DIVPTR S DIVALUE=DIEN Q
64 . S DIVALUE=DIEN_";"_$P(DIFILE(+$P(DISTACK,U,3),"O"),U,2)
65 . Q
66 S DISTACK=(+DISTACK)_U_($P(DISTACK,U,2)-1)_U_F
67 I $P(DISTACK,U,2)=1 D Q
68 . N DIROOT1 S DIROOT1=$S($D(DIFILE(F,"NO B")):DIFILE(F,"NO B"),1:DIFILE(F,"O")_"DINDEX0")_")"
69 . I $O(@DIROOT1@(DIVALUE,""))="" S DIEN="" Q
70 . S DINDEX0(1)=DIVALUE,DIEN=""
71 . S DIFILE=+F
72 . S F=$TR(DIFLAGS,"vp")
73 . D WALK^DICLIX(F,.DINDEX0,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,"",.DIC)
74 . S DIFILE=+$P(DIFILE("STACK"),U,3)
75 . Q
76 ;
77B2 ; loop through matches on pointer index,
78 ; quit when no matches, if not back to root of pointer chain yet,
79 ; make another recursive call to BACKTRAK to unwind to pointing
80 ; file's matches
81 ;
82 S DIEN="" F D Q:DIEN=""!($G(DIERR))
83 . N DIROOT1 S DIROOT1=$S($D(DIFILE(F,"NO B")):DIFILE(F,"NO B"),1:DIFILE(F,"O")_"""B""")_")"
84 . S DIEN=$O(@DIROOT1@(DIVALUE,DIEN))
85 . Q:DIEN=""
86 . D BACKTRAK(.DIFLAGS,.DIFILE,DISTACK,DIEN,DIFIEN,.DINDEX0,.DINDEX,.DIDENT,.DISCREEN,.DILIST)
87 . Q
88 Q
89 ;
90SETB ; Set temporary "B" index on pointed-to files.
91 Q:'$O(DIFILE("STACK",0))
92 N I,J,DIFL,DITEMP
93 F I=0:0 S I=$O(DIFILE("STACK",I)) Q:'I F J=0:0 S J=$O(DIFILE("STACK",I,J)) Q:'J F DIFL=0:0 S DIFL=$O(DIFILE("STACK",I,J,DIFL)) Q:'DIFL I $D(DIFILE(DIFL,"NO B")) D
94 . D TMPB^DICUIX1(.DITEMP,DIFL)
95 . S DIFILE(DIFL,"NO B")=DITEMP
96 . D BLDB^DICUIX1(DIFILE(DIFL),DITEMP)
97 . Q
98 Q
99 ;
Note: See TracBrowser for help on using the repository browser.