- DICF3 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 3 (One Index) ;4/20/99 09:43 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;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
- ;
- ;
- DICF3 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 3 (One Index) ;4/20/99 09:43 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**4**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;
- CHKONE(DIFLAGS,DIVALUE,DINDEX,DIDENT,DIFILE,DIEN,DIFIEN,DISCREEN,DILIST,DIC,DIY,DIYX) ;
- +1 ; Called from CHKALL--check one index for possible matches
- +2 NEW I,DISUB
- FOR DISUB=1:1:DINDEX("#")
- Begin DoDot:1
- +3 FOR I=0:0
- SET I=$ORDER(DINDEX(DISUB,I))
- IF 'I
- QUIT
- KILL DINDEX(DISUB,I)
- +4 QUIT
- End DoDot:1
- C1 ; Set up then find eXact matches.
- +1 IF DIFLAGS["X"
- Begin DoDot:1
- +2 FOR DISUB=1:1:DINDEX("#")
- Begin DoDot:2
- +3 SET (DINDEX(DISUB),DINDEX(DISUB,1))=$GET(DINDEX(DISUB,"FROM"))
- +4 SET DINDEX(DISUB,"USE")=$SELECT(DIFLAGS["Q":1,"VP"[DINDEX(DISUB,"TYPE"):0,1:1)
- +5 IF DISUB>1!("VP"'[DINDEX(1,"TYPE"))
- MERGE DINDEX(DISUB)=DIVALUE(DISUB)
- +6 IF DIFLAGS["Q"
- QUIT
- +7 IF "VP"[DINDEX(DISUB,"TYPE")
- Begin DoDot:3
- +8 SET DINDEX(DISUB)=""
- +9 IF DISUB'=1
- QUIT
- +10 SET DINDEX(1,1)=""
- FOR I=1:0
- SET I=$ORDER(DINDEX(1,I))
- IF 'I
- QUIT
- KILL DINDEX(1,I)
- +11 QUIT
- End DoDot:3
- IF DISUB=1
- QUIT
- +12 SET I=4
- FOR
- SET I=$ORDER(DIVALUE(DISUB,I))
- IF 'I
- QUIT
- SET DINDEX(DISUB,I)=DIVALUE(DISUB,I)
- +13 QUIT
- End DoDot:2
- +14 SET DIDENT(-4)=1
- +15 NEW DIF
- SET DIF=$TRANSLATE(DIFLAGS,"X")_"X"
- +16 SET DINDEX("TOTAL")=DIDENT(-1)
- +17 DO WALK^DICFIX(DIF,.DINDEX,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
- +18 QUIT
- End DoDot:1
- QUIT
- +19 IF $GET(DIERR)!($GET(DINDEX("DONE")))
- QUIT
- C2 ; Find partial matches
- +1 FOR DISUB=1:1:DINDEX("#")
- Begin DoDot:1
- +2 SET (DINDEX(DISUB),DINDEX(DISUB,1))=$GET(DINDEX(DISUB,"FROM"))
- +3 SET DINDEX(DISUB,"USE")=$SELECT(DIFLAGS["Q"!(DINDEX("#")>1):1,DIFLAGS["O":0,1:1)
- +4 IF DISUB>1!("VP"'[DINDEX(1,"TYPE"))
- MERGE DINDEX(DISUB)=DIVALUE(DISUB)
- +5 IF "VP"[DINDEX(DISUB,"TYPE")
- IF DIFLAGS'["Q"
- Begin DoDot:2
- +6 SET DINDEX(DISUB)=""
- SET DINDEX(DISUB,"USE")=0
- +7 IF DISUB'=1
- QUIT
- +8 SET DINDEX(1,1)=""
- FOR I=1:0
- SET I=$ORDER(DINDEX(1,I))
- IF 'I
- QUIT
- KILL DINDEX(1,I)
- +9 QUIT
- End DoDot:2
- IF DISUB=1
- QUIT
- +10 IF DIFLAGS["O"
- FOR I=0:0
- SET I=$ORDER(DISCREEN(DISUB,I))
- IF 'I
- QUIT
- Begin DoDot:2
- +11 IF $DATA(DISCREEN(DISUB,I,2))
- SET DISCREEN(DISUB,I)=DISCREEN(DISUB,I,2)
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET DIDENT(-4)=1
- +15 SET DINDEX("TOTAL")=DIDENT(-1)
- +16 DO WALK^DICFIX(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
- +17 QUIT
- +18 ;
- +19 ;
