DICF3 ;VEN/TOAD,SF/TKW - Lookup: Finder, Part 3 (One Index) ;1/24/13 3:53pm
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;
; Contents
;
; CHKONE: Check One Index for All Possible Matches
;
;
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)
;
C1 ; Set up then find eXact matches.
;
I DIFLAGS["X" D Q
. ;
. F DISUB=1:1:DINDEX("#") D ; loop through lookup values
. . 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)
. . S I=4 F S I=$O(DIVALUE(DISUB,I)) Q:'I S DINDEX(DISUB,I)=DIVALUE(DISUB,I)
. ;
. 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:$G(DIERR)!($G(DINDEX("DONE")))
;
C2 ; Find partial matches
;
F DISUB=1:1:DINDEX("#") D ; loop through lookup values
. 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")) D
. . I DINDEX(DISUB,"WAY")=1 D ; forward traversal, traverse from
. . . M DINDEX(DISUB)=DIVALUE(DISUB) ; start of partial matches
. . I DINDEX(DISUB,"WAY")=-1 D ; backward traversal, traverse from
. . . M DINDEX(DISUB)=DIVALUE("BACK",DISUB) ; end of partial matches
. ;
. 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)
. 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)
;
S DIDENT(-4)=1
S DINDEX("TOTAL")=DIDENT(-1)
;
D WALK^DICFIX(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
;
QUIT ; end of CHKONE
;
;
EOR ; end of routine DICF3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICF3 2699 printed Apr 09, 2024@21:47:35 Page 2
DICF3 ;VEN/TOAD,SF/TKW - Lookup: Finder, Part 3 (One Index) ;1/24/13 3:53pm
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;
+8 ; Contents
+9 ;
+10 ; CHKONE: Check One Index for All Possible Matches
+11 ;
+12 ;
CHKONE(DIFLAGS,DIVALUE,DINDEX,DIDENT,DIFILE,DIEN,DIFIEN,DISCREEN,DILIST,DIC,DIY,DIYX) ;
+1 ; Called from CHKALL--check one index for possible matches
+2 ;
+3 NEW I,DISUB
FOR DISUB=1:1:DINDEX("#")
Begin DoDot:1
+4 FOR I=0:0
SET I=$ORDER(DINDEX(DISUB,I))
if 'I
QUIT
KILL DINDEX(DISUB,I)
End DoDot:1
+5 ;
C1 ; Set up then find eXact matches.
+1 ;
+2 IF DIFLAGS["X"
Begin DoDot:1
+3 ;
+4 ; loop through lookup values
FOR DISUB=1:1:DINDEX("#")
Begin DoDot:2
+5 SET (DINDEX(DISUB),DINDEX(DISUB,1))=$GET(DINDEX(DISUB,"FROM"))
+6 SET DINDEX(DISUB,"USE")=$SELECT(DIFLAGS["Q":1,"VP"[DINDEX(DISUB,"TYPE"):0,1:1)
+7 ;
+8 IF DISUB>1!("VP"'[DINDEX(1,"TYPE"))
MERGE DINDEX(DISUB)=DIVALUE(DISUB)
+9 ;
+10 if DIFLAGS["Q"
QUIT
+11 ;
+12 IF "VP"[DINDEX(DISUB,"TYPE")
Begin DoDot:3
+13 SET DINDEX(DISUB)=""
+14 if DISUB'=1
QUIT
+15 SET DINDEX(1,1)=""
FOR I=1:0
SET I=$ORDER(DINDEX(1,I))
if 'I
QUIT
KILL DINDEX(1,I)
End DoDot:3
if DISUB=1
QUIT
+16 SET I=4
FOR
SET I=$ORDER(DIVALUE(DISUB,I))
if 'I
QUIT
SET DINDEX(DISUB,I)=DIVALUE(DISUB,I)
End DoDot:2
+17 ;
+18 SET DIDENT(-4)=1
+19 NEW DIF
SET DIF=$TRANSLATE(DIFLAGS,"X")_"X"
+20 SET DINDEX("TOTAL")=DIDENT(-1)
+21 ;
+22 DO WALK^DICFIX(DIF,.DINDEX,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
End DoDot:1
QUIT
+23 ;
+24 if $GET(DIERR)!($GET(DINDEX("DONE")))
QUIT
+25 ;
C2 ; Find partial matches
+1 ;
+2 ; loop through lookup values
FOR DISUB=1:1:DINDEX("#")
Begin DoDot:1
+3 SET (DINDEX(DISUB),DINDEX(DISUB,1))=$GET(DINDEX(DISUB,"FROM"))
+4 SET DINDEX(DISUB,"USE")=$SELECT(DIFLAGS["Q"!(DINDEX("#")>1):1,DIFLAGS["O":0,1:1)
+5 ;
+6 IF DISUB>1!("VP"'[DINDEX(1,"TYPE"))
Begin DoDot:2
+7 ; forward traversal, traverse from
IF DINDEX(DISUB,"WAY")=1
Begin DoDot:3
+8 ; start of partial matches
MERGE DINDEX(DISUB)=DIVALUE(DISUB)
End DoDot:3
+9 ; backward traversal, traverse from
IF DINDEX(DISUB,"WAY")=-1
Begin DoDot:3
+10 ; end of partial matches
MERGE DINDEX(DISUB)=DIVALUE("BACK",DISUB)
End DoDot:3
End DoDot:2
+11 ;
+12 IF "VP"[DINDEX(DISUB,"TYPE")
IF DIFLAGS'["Q"
Begin DoDot:2
+13 SET DINDEX(DISUB)=""
SET DINDEX(DISUB,"USE")=0
+14 if DISUB'=1
QUIT
+15 SET DINDEX(1,1)=""
FOR I=1:0
SET I=$ORDER(DINDEX(1,I))
if 'I
QUIT
KILL DINDEX(1,I)
End DoDot:2
if DISUB=1
QUIT
+16 IF DIFLAGS["O"
FOR I=0:0
SET I=$ORDER(DISCREEN(DISUB,I))
if 'I
QUIT
Begin DoDot:2
+17 IF $DATA(DISCREEN(DISUB,I,2))
SET DISCREEN(DISUB,I)=DISCREEN(DISUB,I,2)
End DoDot:2
End DoDot:1
+18 ;
+19 SET DIDENT(-4)=1
+20 SET DINDEX("TOTAL")=DIDENT(-1)
+21 ;
+22 DO WALK^DICFIX(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
+23 ;
+24 ; end of CHKONE
QUIT
+25 ;
+26 ;
EOR ; end of routine DICF3
