Annotation of freem_fileman/DICF5.m, revision 1.1.1.1
1.1 snw 1: DICF5 ;SEA/TOAD-VA FileMan: Finder, Part 5 (Ptr Indexes) ;11/4/94 10:59 ;
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4:
5: PREPP(DIFLAGS,DINDEX,DITYPE,DISKIP,DILIST)
6: ; PREPIX^DICF2--transform value for indexed pointer field
7: ; proc, DINDEX passed by ref
8: N DIF,DINODE,DIPFILE,DIPLIST,DIPVAL,DISAVE
9: S DIF=$TR(DIFLAGS,$TR(DIFLAGS,"Xg"))
10: S DIPVAL=@DILIST("LVA")@("V")
11: S DILIST("SAVE")=DILIST("LVA")
12: S DILIST("LVA")="^TMP(""DILVA"",$J,"_DILIST(0)_")"
13: S DIPLIST=$NA(@DILIST("LVA")@("V"))
14: 90 S DIPLIST(0)=DILIST(0)+1
15: S DIPLIST("LVA")=DILIST("SAVE")
16: S DISAVE=@DILIST("SAVE")@("S")
17: I DISAVE'="" S @DILIST("SAVE")@("S")=""
18: F DINODE="1","2","0,5","0,6" D
19: . S @("DISAVE("_DINODE_")=$G(@DILIST(""SAVE"")@(""S"","_DINODE_"))")
20: . I @("DISAVE("_DINODE_")'=""""") D
21: . . S @("@DILIST(""SAVE"")@(""S"","_DINODE_")=""""")
22: 91 I DITYPE="P" D
23: . S DIPFILE=+$P($P(DINDEX(0,"DEF"),U,2),"P",2)
24: . D FIND^DICF(DIPFILE,"","","Mp"_DIF,"","","","","",.DIPLIST,DIPLIST)
25: . S DISKIP=DIPLIST("C")=0
26: I DISKIP Q
27: 92 I DITYPE="VP" D
28: . N DIFIELD,DIFILE,DIOUT
29: . S DIPLIST("C")=0
30: . S DIFILE=DINDEX(0,"FILE")
31: . S DIFIELD=DINDEX(0,"FIELD")
32: . S DIPFILE=0,DIOUT=0 F D Q:DIOUT
33: . . S DIPFILE=$O(^DD(DIFILE,DIFIELD,"V","B",DIPFILE))
34: . . I DIPFILE="" S DIOUT=1 Q
35: . . D FIND^DICF(DIPFILE,"","","Mpv"_DIF,"","","","","",.DIPLIST,DIPLIST)
36: . . S DISKIP=DIPLIST("C")=0&DISKIP
37: 93 . I DIPVAL["." D PIECES(DIFILE,DIFIELD,DIF,DIPVAL,.DISKIP,.DIPLIST)
38: I 'DISKIP S @DILIST("LVA")@("S")=@DILIST("SAVE")@("S")
39: I DISAVE'="" S @DILIST("SAVE")@("S")=DISAVE
40: F DINODE="1","2","0,5","0,6" D
41: . I @("DISAVE("_DINODE_")'=""""") D
42: . . S @("@DILIST(""SAVE"")@(""S"","_DINODE_")=DISAVE("_DINODE_")")
43: Q
44:
45: PIECES(DIFILE,DIFIELD,DIFLAGS,DIPVAL,DISKIP,DIPLIST)
46: ; proc, add file.value lookups to index's LVA
47: N DILOWER S DILOWER="abcdefghijklmnopqrstuvwxyz"
48: N DIUPPER S DIUPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
49: N DIFILEN S DIFILEN=$TR($P(DIPVAL,"."),DILOWER,DIUPPER)
50: N DIFILES D VPFILES^DIEV1(DIFILE,DIFIELD,DIFILEN,.DIFILES)
51: K DIPLIST("LVA")
52: N DIVALN S DIVALN=$P(DIPVAL,".",2,9999)
53: S DIFILE="" F S DIFILE=$O(DIFILES(DIFILE)) Q:DIFILE="" D
54: . D FIND^DICF(DIFILE,"","","Mlpv"_DIFLAGS,DIVALN,"","","","",.DIPLIST,DIPLIST)
55: S DISKIP=DIPLIST("C")=0&DISKIP
56: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>