VistA-WorldVistAEHR/r/VA_FILEMAN-ARJT-DI-DD-DM-DT.../DICF3.m

50 lines
1.9 KiB
Mathematica

DICF3 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 3 (One Index) ;4/20/99 09:43
;;22.0;VA FileMan;**4**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
CHKONE(DIFLAGS,DIVALUE,DINDEX,DIDENT,DIFILE,DIEN,DIFIEN,DISCREEN,DILIST,DIC,DIY,DIYX) ;
; Called from CHKALL--check one index for possible matches
N I,DISUB F DISUB=1:1:DINDEX("#") D
. F I=0:0 S I=$O(DINDEX(DISUB,I)) Q:'I K DINDEX(DISUB,I)
. Q
C1 ; Set up then find eXact matches.
I DIFLAGS["X" D Q
. F DISUB=1:1:DINDEX("#") D
. . S (DINDEX(DISUB),DINDEX(DISUB,1))=$G(DINDEX(DISUB,"FROM"))
. . S DINDEX(DISUB,"USE")=$S(DIFLAGS["Q":1,"VP"[DINDEX(DISUB,"TYPE"):0,1:1)
. . I DISUB>1!("VP"'[DINDEX(1,"TYPE")) M DINDEX(DISUB)=DIVALUE(DISUB)
. . Q:DIFLAGS["Q"
. . I "VP"[DINDEX(DISUB,"TYPE") D Q:DISUB=1
. . . S DINDEX(DISUB)=""
. . . Q:DISUB'=1
. . . S DINDEX(1,1)="" F I=1:0 S I=$O(DINDEX(1,I)) Q:'I K DINDEX(1,I)
. . . Q
. . S I=4 F S I=$O(DIVALUE(DISUB,I)) Q:'I S DINDEX(DISUB,I)=DIVALUE(DISUB,I)
. . Q
. S DIDENT(-4)=1
. N DIF S DIF=$TR(DIFLAGS,"X")_"X"
. S DINDEX("TOTAL")=DIDENT(-1)
. D WALK^DICFIX(DIF,.DINDEX,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
. Q
Q:$G(DIERR)!($G(DINDEX("DONE")))
C2 ; Find partial matches
F DISUB=1:1:DINDEX("#") D
. S (DINDEX(DISUB),DINDEX(DISUB,1))=$G(DINDEX(DISUB,"FROM"))
. S DINDEX(DISUB,"USE")=$S(DIFLAGS["Q"!(DINDEX("#")>1):1,DIFLAGS["O":0,1:1)
. I DISUB>1!("VP"'[DINDEX(1,"TYPE")) M DINDEX(DISUB)=DIVALUE(DISUB)
. I "VP"[DINDEX(DISUB,"TYPE"),DIFLAGS'["Q" D Q:DISUB=1
. . S DINDEX(DISUB)="",DINDEX(DISUB,"USE")=0
. . Q:DISUB'=1
. . S DINDEX(1,1)="" F I=1:0 S I=$O(DINDEX(1,I)) Q:'I K DINDEX(1,I)
. . Q
. I DIFLAGS["O" F I=0:0 S I=$O(DISCREEN(DISUB,I)) Q:'I D
. . I $D(DISCREEN(DISUB,I,2)) S DISCREEN(DISUB,I)=DISCREEN(DISUB,I,2)
. . Q
. Q
S DIDENT(-4)=1
S DINDEX("TOTAL")=DIDENT(-1)
D WALK^DICFIX(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
Q
;
;