| 1 | DICF3 ;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 | ;
|
|---|
| 5 | CHKONE(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
|
|---|
| 10 | C1 ; 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")))
|
|---|
| 30 | C2 ; 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 | ;
|
|---|
