DICF3.m

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      ;