source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICF3.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: 1.9 KB
RevLine 
[613]1DICF3 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 3 (One Index) ;4/20/99 09:43
2 ;;22.0;VA FileMan;**4**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CHKONE(DIFLAGS,DIVALUE,DINDEX,DIDENT,DIFILE,DIEN,DIFIEN,DISCREEN,DILIST,DIC,DIY,DIYX) ;
6 ; Called from CHKALL--check one index for possible matches
7 N I,DISUB F DISUB=1:1:DINDEX("#") D
8 . F I=0:0 S I=$O(DINDEX(DISUB,I)) Q:'I K DINDEX(DISUB,I)
9 . Q
10C1 ; Set up then find eXact matches.
11 I DIFLAGS["X" D Q
12 . F DISUB=1:1:DINDEX("#") D
13 . . S (DINDEX(DISUB),DINDEX(DISUB,1))=$G(DINDEX(DISUB,"FROM"))
14 . . S DINDEX(DISUB,"USE")=$S(DIFLAGS["Q":1,"VP"[DINDEX(DISUB,"TYPE"):0,1:1)
15 . . I DISUB>1!("VP"'[DINDEX(1,"TYPE")) M DINDEX(DISUB)=DIVALUE(DISUB)
16 . . Q:DIFLAGS["Q"
17 . . I "VP"[DINDEX(DISUB,"TYPE") D Q:DISUB=1
18 . . . S DINDEX(DISUB)=""
19 . . . Q:DISUB'=1
20 . . . S DINDEX(1,1)="" F I=1:0 S I=$O(DINDEX(1,I)) Q:'I K DINDEX(1,I)
21 . . . Q
22 . . S I=4 F S I=$O(DIVALUE(DISUB,I)) Q:'I S DINDEX(DISUB,I)=DIVALUE(DISUB,I)
23 . . Q
24 . S DIDENT(-4)=1
25 . N DIF S DIF=$TR(DIFLAGS,"X")_"X"
26 . S DINDEX("TOTAL")=DIDENT(-1)
27 . D WALK^DICFIX(DIF,.DINDEX,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
28 . Q
29 Q:$G(DIERR)!($G(DINDEX("DONE")))
30C2 ; Find partial matches
31 F DISUB=1:1:DINDEX("#") D
32 . S (DINDEX(DISUB),DINDEX(DISUB,1))=$G(DINDEX(DISUB,"FROM"))
33 . S DINDEX(DISUB,"USE")=$S(DIFLAGS["Q"!(DINDEX("#")>1):1,DIFLAGS["O":0,1:1)
34 . I DISUB>1!("VP"'[DINDEX(1,"TYPE")) M DINDEX(DISUB)=DIVALUE(DISUB)
35 . I "VP"[DINDEX(DISUB,"TYPE"),DIFLAGS'["Q" D Q:DISUB=1
36 . . S DINDEX(DISUB)="",DINDEX(DISUB,"USE")=0
37 . . Q:DISUB'=1
38 . . S DINDEX(1,1)="" F I=1:0 S I=$O(DINDEX(1,I)) Q:'I K DINDEX(1,I)
39 . . Q
40 . I DIFLAGS["O" F I=0:0 S I=$O(DISCREEN(DISUB,I)) Q:'I D
41 . . I $D(DISCREEN(DISUB,I,2)) S DISCREEN(DISUB,I)=DISCREEN(DISUB,I,2)
42 . . Q
43 . Q
44 S DIDENT(-4)=1
45 S DINDEX("TOTAL")=DIDENT(-1)
46 D WALK^DICFIX(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
47 Q
48 ;
49 ;
Note: See TracBrowser for help on using the repository browser.