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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1DICL10 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 2 ;5/21/98 15:27
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5POINT(DIFILE,DIFLAGS,DINDEX,DIDENT,DIEN,DIFIEN,DISCREEN,DILIST) ;
6 ; save off the primary file info, follow the ptr chain to the end
7 S DIFLAGS=DIFLAGS_"p"
8 N DIVPTR,DIF S DIVPTR=$S(DINDEX(1,"TYPE")="V":1,1:0)
9 M DIF=DIFILE N DIFILE M DIFILE=DIF K DIF
10 D FOLLOW^DICL3(.DIFILE,"",DINDEX(1,"NODE"),1,0,"",DINDEX(1,"FIELD"),DINDEX(1,"FILE"),DIVPTR,1,.DISCREEN)
11 D SETB^DICL3
12 N DIX1 S DIX1="B"
13 S DIX1("WAY")=DINDEX("WAY")
14 N DIFROM S DIFROM(1)=$G(DINDEX(1,"FROM")),DIFROM("IEN")=""
15 N DIPART S DIPART(1)=$G(DINDEX(1,"PART"))
16 S DIFILE("STACK")=1_U_DIFILE("STACKEND",1)
17 S DIFILE=$P(DIFILE("STACK"),U,3)
18 D INDEX^DICUIX(.DIFILE,.DIFLAGS,.DIX1,.DIFROM,.DIPART)
19 I $G(DINDEX(1,"USE")) S DIX1(1,"USE")=1
20 N I F I="FIELD","FILE","FROM","GET","TYPE" K DIX1(1,I)
21 K DIX1("FLIST")
22P1 ; no variable pointers in pointer chain
23 I '$O(DIFILE("STACKEND",1)) D Q
24 . D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,"",.DIC)
25 . Q
26P2 ; variable pointer(s) in pointer chain
27 N DIXV
28 S DIFLAGS=DIFLAGS_"v",DIFILE("STACK")=""
29 S I=0 F S I=$O(DIFILE("STACKEND",I)) Q:'I D
30 . N DIXNAME,DISUB,R S DIXNAME="DIXV("_I_")",DISUB=DIX1(1)
31 . N DIFL,DIGL S DIFL=+$P(DIFILE("STACKEND",I),U,2),DIGL=DIFILE(DIFL,"O")
32 . S @DIXNAME@(1)=DISUB,@DIXNAME@(1,"MORE?")=DIX1(1,"MORE?"),@DIXNAME@(2)=""
33 . S R=DIGL_"DINDEX"
34 . S @DIXNAME@(1,"ROOT")=R_")",@DIXNAME@(2,"ROOT")=R_",DINDEX(1))"
35 . I $G(DINDEX(1,"USE")),DISUB'="" D
36 . . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB),-DIX1(1,"WAY"))
37 . . S @DIXNAME@(1)=DISUB
38 . . Q
39 . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB)),@DIXNAME@(1,"NXTVAL")=DISUB
40 . I DISUB="" K @DIXNAME,DIFILE("STACKEND",I) Q
41 . Q:DIFILE("STACK")
42 . S DIFILE("STACK")=I_U_DIFILE("STACKEND",I)
43 . Q
44 K DIX1(1,"USE")
45 I +DIFILE("STACK")=1 S DIX1(1)=DIXV(1,1)
46 E S I="DIXV("_+DIFILE("STACK")_")" M DIX1=@I
47 D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,.DIXV,.DIC)
48 Q
49 ;
Note: See TracBrowser for help on using the repository browser.